Macro per inoltrare webmail con allegato
Hai un problema con Excel?
Macro per inoltrare webmail con allegato
di marco_budin data: 13/03/2017 07:56:52
ciao a tutti,
ho creato una macro (tasto grigio "mail") che allega e invia una mail da Outlook desktop. Purtroppo al lavoro non abbiamo Outlook su desktop, ma utilizziamo webmail (Connesso a Microsoft Exchange). Dovrei quindi creare un codice che:
1- apre internet Explorer (hhtps webmail. eoc. ch) - Server: webmail eoc ch - Dominio: eocnet
2- inserisce automaticamente nome utente e password (come da codice sotto)
3- creare una nuova mail e inserire automaticamente i destinatari, destinatari in copia, oggetto e testo (come da codice sotto)
4- stampare da Excel e creare il pdf (come da codice)
5- allegare il pdf (come da codice)
6 - inviare la mail (come da codice)
7 chiudere internet Explorer e tornare sulla cella (come da codice sotto)
è un grosso problema che non riesco a risolvere, spero che qualcuno di voi possa aiutarmi nel mio problema.
in attesa di una vostra risposta,
vi auguro una buona serata
Marco
Sub email2()
Dim AppMail As Object 'Outlook.Application
Dim NewMail As Object 'Outlook.Application
Dim miaDir
Dim MioWBK As Workbook
Dim MioSheet As Worksheet
Dim Nome As String
Dim Cognome As String
Dim indirizziTO As String
Dim IndirizziCC As String
Dim NomeFile As String
Dim Oggetto As String
Dim Testo As String
Set MioWBK = ActiveWorkbook
Set MioSheet = ActiveWorkbook.Sheets("stroke")
miaDir = "O:NeuroradiologiaSala Angio"
Nome = MioSheet.Range("w4")
Cognome = MioSheet.Range("z4")
NomeFile = Nome & "_" & Cognome & ".pdf"
Sheets("Fatturazione neuro stroke").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
miaDir & "/" & NomeFile, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error Resume Next
Set AppMail = GetObject(, "Outlook.Application")
If Err.Number <> 0 Then
Err.Clear
Set AppMail = CreateObject("Outlook.Application")
AppMail.Session.Logon
If Err <> 0 Then
MsgBox "Could not load Outlook", vbOKOnly + vbInformation, "Error report"
End
End If
End If
indirizziTO = ""
IndirizziCC = ""
Set NewMail = AppMail.CreateItem(0)
Oggetto = "Invio Documentazione"
Testo = "Egregio Signor Budin" & vbCrLf
Testo = Testo & "Le Invio la documentazione allegata:" & vbCrLf
Testo = Testo & " - " & NomeFile & vbCrLf & vbCrLf
Testo = Testo & "Cordiali Saluti" & vbCrLf
With NewMail
.To = indirizziTO
.CC = IndirizziCC
.Subject = Oggetto
.body = Testo & .body
.Attachments.Add miaDir & "/" & NomeFile
.Display
End With
NewMail.SEND
Sheets("stroke").Select
Range("k5").Select
End Sub |
di Albatros54 data: 13/03/2017 11:02:49
non so se ti puo essere utile.
h_t_t_p://www.rondebruin.nl/win/s1/cdo.htm
di marco_budin data: 13/03/2017 12:35:44
Ciao Albatros54,
ti ringrazio moltissimo per il tuo link! è molto utile. infatti nomina le cose di cui avrei bisogno. Il codice che avevo allegato mi aveva aiutato uno della community ExcelVBA (che ringrazio tantissimo), perché non ero in grado di farlo.
Ho letto un po' i codici dell'esempio che ho trovato nel sito che mi hai allegato, ma non riesco ad adattarlo alle mie esigenze. Sapresti aiutarmi?
Utilizzo appunto Microsoft outlookWebApp (Exchange) e come mail avrei Marco.budin @ eoc.ch, server: webmail.eoc.ch, dominio: eocnet, username: e password:
crea e allega i documenti come descritto nel codice precedentemente allegato e creato da voi.
ringraziandoti anticipatamente,
ti auguro una buona giornata
saluti
Marco
di Albatros54 data: 14/03/2017 13:53:16
prova a sostituire lo spezzone di codice nella sub email2(), con quello sotto.
ciao
albatros54
Da sostituire
___________________________________________________________________
Set AppMail = GetObject(, "Outlook.Application")
'If Err.Number <> 0 Then
' Err.Clear
' Set AppMail = CreateObject("Outlook.Application")
' AppMail.Session.Logon
'
' If Err <> 0 Then
' MsgBox "Could not load Outlook", vbOKOnly + vbInformation, "Error report"
' End
' End If
'End If
Con
=========================================================
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "h_t_t_p_s://webmail.eoc.ch/logon.aspx"<< |
di Albatros54 data: 14/03/2017 13:54:28
prova a sostituire lo spezzone di codice nella sub email2(), con quello sotto.
ciao
albatros54
il codice è questo:
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "h_t_t_p_s://webmail.eoc.ch/logon.aspx"
Do Until .ReadyState = 4
Loop
.Document.All.Item("username").Value = "LeTueCredenziali_Mail"
.Document.All.Item("password").Value = "LeTueCredenziali_Password"
.Document.All.Item("Accedi").Click
End With
=========================================================
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "h_t_t_p_s://webmail.eoc.ch/logon.aspx"<< |
di marco_budin data: 14/03/2017 15:04:19
ciao Albatros54! ti ringrazio molto del tuo aiuto, ho sostituito il codice che tu mi hai suggerito. Praticamente apre il sito e fa l'accesso in maniera automatica mettendo appunto dentro username e password.
Purtroppo si ferma li. Infatti non crea in automatico la mail, non allega il file.
Hai suggerimenti?
ti ringrazio moltissimo del tuo prezioso aiuto
saluti
Marco
Sub email2()
Dim AppMail As Object 'Outlook.Application
Dim NewMail As Object 'Outlook.Application
Dim miaDir
Dim MioWBK As Workbook
Dim MioSheet As Worksheet
Dim Nome As String
Dim Cognome As String
Dim indirizziTO As String
Dim IndirizziCC As String
Dim NomeFile As String
Dim Oggetto As String
Dim Testo As String
Set MioWBK = ActiveWorkbook
Set MioSheet = ActiveWorkbook.Sheets("stroke")
miaDir = "O:NeuroradiologiaSala Angio"
Nome = MioSheet.Range("w4")
Cognome = MioSheet.Range("z4")
NomeFile = Nome & "_" & Cognome & ".pdf"
Sheets("Fatturazione neuro stroke").Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
miaDir & "/" & NomeFile, Quality:= _
xlQualityStandard, IncludeDocProperties:=False, IgnorePrintAreas:=False, _
OpenAfterPublish:=False
On Error Resume Next
Set ie = CreateObject("InternetExplorer.Application")
With ie
.Visible = True
.Navigate "h_ttps://webmail.eoc.ch/"
Do Until .ReadyState = 4
Loop
.Document.All.Item("username").Value = "mio username"
.Document.All.Item("password").Value = "mia password"
.Document.All.Item("Accedi").Click
End With
indirizziTO = "marco.budin@eoc.ch"
IndirizziCC = ""
Set NewMail = AppMail.CreateItem(0)
Oggetto = "Invio Documentazione"
Testo = "Egregio Signor Budin" & vbCrLf
Testo = Testo & "Le Invio la documentazione allegata:" & vbCrLf
Testo = Testo & " - " & NomeFile & vbCrLf & vbCrLf
Testo = Testo & "Cordiali Saluti" & vbCrLf
With NewMail
.To = indirizziTO
.CC = IndirizziCC
.Subject = Oggetto
.body = Testo & .body
.Attachments.Add miaDir & "/" & NomeFile
.Display
End With
NewMail.SEND
Sheets("stroke").Select
Range("k5").Select
End Sub
|
di Albatros54 data: 15/03/2017 10:59:21
Ciao Marco, ho cercato di risolvere il tuo problema, ma sicuramente il codice non funziona, perchè non so,è chiedo lumi a qualche luminare,come il webmail, crea l'oggetto a cui affidare tutti i paramentri della tue email,aspettando fiducioso l'intervento di qualche GURU, a cui affidare la soluzione.
albatros54
(dal profondo SUD)
Vuoi Approfondire?