2017-05-02 2 views
2

J'essaie d'utiliser ma signature par défaut lorsque j'envoie un e-mail automatisé, y a-t-il un moyen de réparer mon code? Mon code finit par coller l'emplacement de la signature plutôt que la signature elle-même. S'il vous plaît donnez votre avis.Signature dans la macro d'e-mail

Sub CreateEmailForGTB() 

    Dim wb As Workbook 

    Set wb = Workbooks.Add 
    ThisWorkbook.Sheets("BBC").Copy After:=wb.Sheets(1) 

    'save the new workbook in a dummy folder 
    wb.SaveAs "location.xlsx" 

    'close the workbook 
    ActiveWorkbook.Close 

    'open email 
Dim OutApp As Object 
Dim OutMail As Object 
Dim newDate: newDate = Format(DateAdd("M", -1, Now), "MMMM") 
Dim sigstring As String 


Set OutApp = CreateObject("Outlook.Application") 
Set OutMail = OutApp.CreateItem(0) 

sigstring = Environ("appdata") & _ 
       "\Microsoft\Signatures\zbc.htm" 


    'fill out email 
With OutMail 
    .To = "[email protected];" 
     .CC = "[email protected];" 
     .BCC = "" 
     .Subject = "VCR - CVs for BBC " & "- " & newDate & " month end." 
     .Body = "Hi all," & vbNewLine & vbNewLine & _ 
       "Please fill out the attached file for " & newDate & " month end." & vbNewLine & vbNewLine & _ 
       "Looking forward to your response." & vbNewLine & vbNewLine & _ 
       "Many thanks." & vbNewLine & vbNewLine & _ 
       sigstring 
+0

Pouvez-vous publier le reste de votre code 'With OutMail'? – 0m3r

Répondre

1

Il existe une autre façon de saisir la signature dans un message électronique, qui est plus facile à utiliser selon moi. Cela nécessite que vous ayez configuré votre signature pour qu'elle s'affiche sur les nouveaux messages par défaut.

Voir la routine que j'ai définie ci-dessous pour la mise en œuvre.

Sub SendMail(strTo As String, strSubject As String, strBody As String, strAttachments As String, Optional strCC As String, Optional strFolder As String, Optional blSend As Boolean) 

'******************************************************************* 
'** Sub:   SendMail 
'** Purpose:  Prepares email to be sent 
'** Notes:  Requires declaration of Outlook.Application outside of sub-routine 
'**     Passes file name and folder for attachments separately 
'**     strAttachments is a "|" separated list of attachment paths 
'******************************************************************* 

'first check if outlook is running and if not open it 
Dim olApp As Outlook.Application 

On Error Resume Next 
Set olApp = GetObject(, "Outlook.Application") 
On Error GoTo 0 
If olApp Is Nothing Then Set olApp = New Outlook.Application 

Dim olNS As Outlook.Namespace 
Dim oMail As Outlook.MailItem 

'login to outlook 
Set olNS = olApp.GetNamespace("MAPI") 
olNS.Logon 

'create mail item 
Set oMail = olApp.CreateItem(olMailItem) 

'display mail to get signature 
With oMail 
    .display 
End With 

Dim strSig As String 
strSig = oMail.HTMLBody 

'build mail and send 
With oMail 

    .To = strTo 
    .CC = strCC 
    .Subject = strSubject 
    .HTMLBody = strBody & strSig 

    Dim strAttach() As String, x As Integer 
    strAttach() = Split(strAttachments, "|") 

    For x = LBound(strAttach()) To UBound(strAttach()) 
     If FileExists(strFolder & strAttach(x)) Then .Attachments.Add strFolder & strAttach(x) 
    Next 

    .display 
    If blSend Then .send 

End With 

Set olNS = Nothing 
Set oMail = Nothing 

End Sub 
0

Vous devez obtenir le texte du fichier plutôt que de simplement définir le chemin du fichier comme une chaîne comme vous l'êtes maintenant. Je vous suggère quelque chose comme ceci:

Function GetText(sFile As String) As String 

   Dim nSourceFile As Integer, sText As String 

   ''Close any open text files 
   Close 

   ''Get the number of the next free text file 
   nSourceFile = FreeFile 

   ''Write the entire file to sText 
   Open sFile For Input As #nSourceFile 
   sText = Input$(LOF(1), 1) 
   Close 

   GetText = sText 

End Function 

Source: http://www.exceluser.com/excel_help/questions/vba_textcols.htm

Vous pouvez alors utiliser simplement dans votre code:

sigstring = GetText(Environ("appdata") & "\Microsoft\Signatures\zbc.htm") 
0

votre variable sigstring est littéralement juste le nom du fichier - Vous n'avez jamais lu le contenu du fichier. Pour lire le contenu, essayez ceci (et n'oubliez pas de déclarer une variable (text et line dans mon exemple) pour contenir le contenu du fichier).

sigstring = Environ("appdata") & "\Microsoft\Signatures\zbc.htm" 
Open sigstring For Input As #1 
Do Until EOF(1) 
    Line Input #1, line 
    text = text & line 
Loop 
Close #1