#1
|
|||
|
|||
Help me with my piecemeal VBA
I know just enough to mess things up.
What this code should do is" ask for the index number to "lookup" info from SettlementList spreadsheet (which does have multiple rows with the same index) print a copy of each record create a pdf of each record saved into the file folder email each pdf to the email associated with the record. Everything works ALMOST correct except: The printout as well as the created pdf has all records with the input index number, so instead of just one page with Mary's row of data, it has a second page with Mark's data. The hard copy printout prints multiple copies. My apologies for the hack-job of code below, but any direction would be greatly appreciated. I'm guessing it's the multiple indexes, as I used most of the code from another macro that works fine and purpose is to do nearly the same thing but with single instances of the index. The difference is that I need the multiple instances to be utilized in the emails and pdf creations. Code:
Sub SettlementLetter() Dim MainDoc As Document, TargetDoc As Document Dim dbPath As String Dim recordNumber As Long, totalRecord As Long Dim strCLMNUM As String Dim PdfPath As String Set MainDoc = ActiveDocument With MainDoc.Mailmerge strCLMNUM = InputBox("What is the claim number we are saving as a PDF?", "CLAIM QUERY", "Type the EXACT Claim Number here.") If strCLMNUM = Null Then Exit Sub ElseIf strCLMNUM = "" Then Exit Sub 'ElseIf strCLMNUM = "" Then Else: Dim QryStrg As String QryStrg = "SELECT * FROM [SettlementList$] WHERE Claim_Number = " & "'" & strCLMNUM & "'" '// if you want to specify your data, insert a WHERE clause in the SQL statement .OpenDataSource Name:=SOURCE_FILE_PATH, sqlstatement:="SELECT * FROM [SettlementList$]" .DataSource.QueryString = QryStrg totalRecord = .DataSource.RecordCount 'For recordNumber = 1 To totalRecord For recordNumber = 1 To 1 With .DataSource .ActiveRecord = recordNumber .FirstRecord = wdDefaultFirstRecord .LastRecord = wdDefaultLastRecord End With .Destination = wdSendToNewDocument .Execute False Set TargetDoc = ActiveDocument PdfPath = FOLDER_SAVED & .DataSource.DataFields("FILE_Name").Value & " " & .DataSource.DataFields("FILE_ID").Value & "\" & .DataSource.DataFields("Claim_Number").Value & "\" & .DataSource.DataFields("Claim_Number").Value & .DataSource.DataFields("First_Name").Value & .DataSource.DataFields("Last_Name").Value & "Settlement Letter.pdf" TargetDoc.ExportAsFixedFormat PdfPath, exportformat:=wdExportFormatPDF TargetDoc.PrintOut Copies:=1 Application.Dialogs(wdDialogFilePrint).Show Dim edress As String Dim subj As String Dim message As String Dim filename As String Dim outlookapp As Object Dim outlookmailitem As Object Dim myAttachments As Object Dim path As String Dim lastrow As Integer Dim attachment As String Dim x As Integer 'x = 2 ''Do While Sheet1.Cells(x, 1) (the symbol for not equal to) "" Set outlookapp = CreateObject("Outlook.Application") Set outlookmailitem = outlookapp.createitem(0) Set myAttachments = outlookmailitem.Attachments path = "PdfPath" 'edress = L@.com edress = .DataSource.DataFields("Email").Value subj = .DataSource.DataFields("Last_Name").Value & " " & .DataSource.DataFields("Claimant_ID_Number").Value & " " & .DataSource.DataFields("Claim_Number").Value & "SETTLEMENT" filename = .DataSource.DataFields("Claim_Number").Value & .DataSource.DataFields("First_Name").Value & .DataSource.DataFields("Last_Name").Value & "Settlement Letter.pdf" attachment = PdfPath outlookmailitem.To = edress outlookmailitem.cc = "" outlookmailitem.bcc = "" outlookmailitem.Subject = subj 'outlookmailitem.body = .DataSource.DataFields("First_Name").Value & "," & vbCrLf & vbCrLf & "Your claim has been settled with the Carrier." & vbCrLf & vbCrLf & "Please keep the attached copy of the settlement for your records and do not hesitate to contact me at my number below." myAttachments.Add (attachment) outlookmailitem.Display '''outlookmailitem.send '''lastrow = lastrow + 1 '''edress = "" 'x = x + 1 Set outlookapp = Nothing Set outlookmailitem = Nothing Set outlookapp = CreateObject("Outlook.Application") Set outlookmailitem = outlookapp.createitem(0) Set myAttachments = outlookmailitem.Attachments 'edress = L@.com 'edress = .DataSource.DataFields("Email_Address").Value ''subj = .DataSource.DataFields("Name").Value & " " & .DataSource.DataFields("Claimant_ID_Number").Value & " " & .DataSource.DataFields("Claim_Number").Value ''filename = .DataSource.DataFields("Claim_Number").Value & ".pdf" ''attachment = PdfPath ''outlookmailitem.To = "L@.com" ''outlookmailitem.cc = "" ''outlookmailitem.bcc = "t@.com" ''outlookmailitem.Subject = subj ''outlookmailitem.body = "The attached claim is hereby submitted." & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & "Best Regards," & vbCrLf & vbCrLf & "Tr" & vbCrLf & "Vi" & vbCrLf & "AlT" & vbCrLf & "618" ''myAttachments.Add (attachment) ''outlookmailitem.Display '''outlookmailitem.send lastrow = lastrow + 1 edress = "" 'x = x + 1 TargetDoc.Close False Set TargetDoc = Nothing 'Stop Next recordNumber 'Stop End If End With Set MainDoc = Nothing End Sub |
#2
|
|||
|
|||
So after thinking about it for a while, I'm not sure how I can narrow down the filter more. I have multiple emails to send based on a date and a file. Some persons have multiple files on the same date. Any ideas on what to do?
Quote:
|
#3
|
||||
|
||||
I don't do enough mail merges to spot logic errors without stepping through the code - which requires files to align with the macros you posted.
Can you load sample docs for your mail merge and datasource so that we don't need to create those from scratch in order to examine your problem?
__________________
Andrew Lockton Chrysalis Design, Melbourne Australia |
#4
|
|||
|
|||
I think I found a pretty simple work around. I'm using the macro to save the pdf files and setting the mailmerge as an email so it send it off to the end user. I appreciate the interest. I might fool with it more to get it to one click, but this will work for now.
|
|