locked
How to mail merge a file with a variable in its name automatically? RRS feed

  • Question

  • Every day I receive a excel file with a list of emails on it, and I need to mail out a document to those emails. The name of the excel sheet is always the exact same with the exception of the date at the end i.e. Rate Qualification 09.10.15 today and  Rate Qualification 09.11.15 tomorrow. I am trying to set a macro that will send this document to the days new list automatically. 

    Here is what I have so far:

    Sub RQT2()
    '
    ' RQT2 Macro
    '
    '
    
    Dim TD As String
    
    TD = Format(Date, "mm.dd.yy")
    RQES = "'D:\Rate_Qualification_Emails_' & TD & '.xlsx'"
        ActiveDocument.MailMerge.OpenDataSource Name:= _
            RQES _
            , ConfirmConversions:=False, ReadOnly:=False, LinkToSource:=True, _
            AddToRecentFiles:=False, PasswordDocument:="", PasswordTemplate:="", _
            WritePasswordDocument:="", WritePasswordTemplate:="", Revert:=False, _
            Format:=wdOpenFormatAuto, Connection:= _
            "Provider=Microsoft.ACE.OLEDB.12.0;User ID=Admin;Data Source=RQES;Mode=Read;Extended Properties=""HDR=YES;IMEX=1;"";Jet OLEDB:System database="""";Jet OLEDB:Registry Path="""";Jet OL" _
            , SQLStatement:="SELECT * FROM `Sheet1$`", SQLStatement1:="", SubType:= _
            wdMergeSubTypeAccess
        With ActiveDocument.MailMerge
            .Destination = wdSendToEmail
            .SuppressBlankLines = True
            With .DataSource
                .FirstRecord = wdDefaultFirstRecord
                .LastRecord = wdDefaultLastRecord
            End With
            .Execute Pause:=False
        End With
    This code almost works, but opens a request to confirm data source. Little help? please and thank you.

    Thursday, September 10, 2015 9:09 AM

All replies

  • The code doesn't 'almost work'. It involves three applications (Outlook, Word and Excel) and doesn't properly address any of them.

    Which of the three applications do you want to run this code from? If you are receiving the worksheet as an e-mail attachment, it would make sense to run it from Outlook, as it could then be run automatically. Then the name wouldn't matter so much as it's the workbook attached to the received message.

    Whether or not that is possible, we still have to establish what the document is that you are e-mailing to the addresses in that workbook. Is it a mail merge as your code implies? Is the data for that mail merge in the workbook?

    If the answer to both those questions is yes, then it might save you some time to use http://www.gmayor.com/ManyToOne.htm  in one to one mode. If not then let us know exactly what you are trying to do and the nature of the 'document'.


    Graham Mayor - Word MVP
    www.gmayor.com

    Thursday, September 10, 2015 11:46 AM
  • I'm sorry. I was trying to be concise, and left a few things out. I'll be more clear. every day I generate a text document from a program at work that looks like this.

    name email

    1. Sally sally@email.com
    2. Eric Eric@email.com
    3. Kelly ____________

    I save the .txt document and import it to Excel so I can find Kelly's email and finish the list. I then save the finished Excel list as Rate_Qualification_emails_09.10.15 or( today's date). I then open the word document I need to send to everyone, and mail merge with today's Excel file, and use Microsoft words "Finish & Merge" option to send out the emails. I have been using powershell and VBA to make this process take no human interaction at all. I just cant figure out how to make VBA chose today's Excel list. I got this code from Microsoft word by recording macro, and selecting a file a file already on my computer. Then I tried changing the file name to include a variable for the current date "TD" Which made it no longer work. I have tried keeping the same Excel file and using different Sheets, but I run into the same variable problem.

    Last thing I should say is I have 0 admin rights on my work computer, so I cannot download/install anything.

    Thursday, September 10, 2015 3:06 PM
  • If the text file contains the names and e-mail addresses and that is all that you are 'merging' then I don't see the point of the Excel conversion. You can use the text file to create the messages.

    Assuming that the document you are sending to the recipients is not personalised, you don't need mail merge. You need a Word macro that will send the document to each address in your text list. The following code will do that.

    The macro assumes that you will send the document as the body of an e-mail message (though it can send as attachment) and that the text document has the same name each time (again that can be changed)

    The line

    Const strMessage As String = "This is the message body"

    is required whether or not you send as attachment, but is only used when you send an attachment. Test with a short list to ensure that it works as you require, then remove the apostrophe from the start of the line

            '.Send        'restore after testing

    The message will add the default signature for the sending account. If you don't want that, omit

    (0, 0) from the line

    Set oRng = wdDoc.Range(0, 0)

    I have to say that a company policy that doesn't allow you to install third party products, but which allows inexperienced VBA users to dabble with processes that are capable of doing more harm than good seems extraordinarily reckless. I make no guarantees about the code here other than that it works in my system.

    Option Explicit
    Sub MailToList()
    'Word macro by Graham Mayor
    
    Const strFname As String = "D:\Path\data.txt"        'the name and path of the text file
    Const strSubject As String = "This is the message subject"
    Const strMessage As String = "This is the message body"
    
    Dim strData As String
    Dim vData As Variant
    ActiveDocument.Save
    
        Open strFname For Input As #1
        Do Until EOF(1)
            Line Input #1, strData
            vData = Split(strData, Chr(32))
            If InStr(1, vData(UBound(vData)), "@") > 0 Then
                Send_As_Mail CStr(vData(UBound(vData))), strSubject, strMessage, False
            End If
        Loop
        Close #1
    lbl_Exit:
        Exit Sub
    End Sub
    
    Sub Send_As_Mail(strTo As String, _
                            strSubject As String, _
                            strMessage As String, _
                            Optional bSendAsAttachment As Boolean, _
                            Optional bPDFFormat As Boolean, _
                            Optional strAttachment As String)
    'bSendAsAttachment - Enter True/False - indicate whether to send the active document as an attachment
    'Word macro by Graham Mayor
    
    Dim olApp As Object
    Dim olInsp As Object
    Dim oItem As Object
    Dim wdDoc As Object
    Dim oRng As Object
    Dim bStarted As Boolean
    Dim oDoc As Document
    Dim strDocName As String
    Dim strPath As String
    Dim intPos As Integer
    Dim iFormat As Long
    
        Set oDoc = ActiveDocument
        If Not bSendAsAttachment Then oDoc.Range.Copy
        If bSendAsAttachment Then
            'On Error GoTo Err_Handler
            'Prompt the user to save the document
            If bPDFFormat Then
                strDocName = oDoc.name
                strPath = oDoc.Path & "\"
                intPos = InStrRev(strDocName, ".")
                strDocName = Left(strDocName, intPos - 1)
                strDocName = strPath & strDocName & ".pdf"
                oDoc.ExportAsFixedFormat OutputFilename:=strDocName, _
                                         ExportFormat:=wdExportFormatPDF, _
                                         OpenAfterExport:=False, _
                                         OptimizeFor:=wdExportOptimizeForPrint, _
                                         Range:=wdExportAllDocument, From:=1, to:=1, _
                                         Item:=wdExportDocumentContent, _
                                         IncludeDocProps:=True, _
                                         KeepIRM:=True, _
                                         CreateBookmarks:=wdExportCreateHeadingBookmarks, _
                                         DocStructureTags:=True, _
                                         BitmapMissingFonts:=True, _
                                         UseISO19005_1:=False
            Else
                strDocName = oDoc.FullName
            End If
        End If
        On Error Resume Next
        'Get Outlook if it's running
        Set olApp = GetObject(, "Outlook.Application")
        'Outlook wasn't running, start it from code
        If olApp = "" Then
            Set olApp = CreateObject("Outlook.Application")
            bStarted = True
        End If
        If olApp = "" Then
            MsgBox "Outlook Not available."
            GoTo lbl_Exit
        End If
        'On Error GoTo Err_Handler:
    
        'Create a new mailitem
        Set oItem = olApp.CreateItem(0)
    
        With oItem
            .to = strTo
            .Subject = strSubject
            If bSendAsAttachment Then .Attachments.Add strDocName
            If Not strAttachment = "" Then .Attachments.Add strAttachment
            .BodyFormat = 2        'olFormatHTML
            Set olInsp = .GetInspector
            Set wdDoc = olInsp.WordEditor
            Set oRng = wdDoc.Range(0, 0)
            .Display
            If bSendAsAttachment Then
                oRng.Text = strMessage & vbCr
            Else
                oRng.Paste
            End If
            '.Send        'restore after testing
        End With
        If bStarted Then olApp.Quit
    lbl_Exit:
        Set oItem = Nothing
        Set olApp = Nothing
        Set olInsp = Nothing
        Set wdDoc = Nothing
        Set oDoc = Nothing
        Set oRng = Nothing
        Exit Sub
    err_handler:
        Resume lbl_Exit
    End Sub
    
    
    
    


    Graham Mayor - Word MVP
    www.gmayor.com

    • Proposed as answer by ryguy72 Saturday, September 12, 2015 12:15 AM
    Friday, September 11, 2015 7:09 AM
  • "I have to say that a company policy that doesn't allow you to install third party products, but which allows inexperienced VBA users to dabble with processes that are capable of doing more harm than good seems extraordinarily reckless."

    LOLLLLL!!!!


    Knowledge is the only thing that I can give you, and still retain, and we are both better off for it.

    Saturday, September 12, 2015 12:16 AM