![]() |
#1
|
|||
|
|||
![]()
Hello,
The intention here is to have a userform, fill in data, select a number of documents, populate those docs with data from the userform, save as .pdf.... and then attach those .pdf to an email without reselecting the files via a dialogue box. The code here works... except for attaching the files to the email. I can see there is a Filename.name associated in a For Next loop of .vrtSelectItems. I am wondering how to keep the location/name data for use in the .Attachments.Add. Code:
'the following part is from an existing project which MacroPod contributed greatly in 2014 Dim i As Long Dim Fldr As String Dim FileName As String Dim vrtSelectedItem As Variant Dim WordApp As Word.Application Dim wdDoc As Word.Document Dim wbXL As Excel.Workbook 'this part selects the destination folder With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = "C:\Users\XYZ\Documents\SRC\SWMS Pack Demo Excel\Customers" .AllowMultiSelect = False .Title = "Select Destination Folder for the SWMS" If .Show = -1 Then Fldr = .SelectedItems(1) Else Exit Sub End If End With MBxAns = MsgBox(Fldr, vbOKCancel, "The Destination Folder is...") If MBxAns = vbCancel Then Exit Sub 'This part selects the target files for updating and saving as pdf in the selected folder With Application.FileDialog(msoFileDialogFilePicker) .InitialFileName = "C:\Users\XYZ\Documents\SRC\SWMS Pack Demo EXCEL" .Title = "Select the Safety Templates" .AllowMultiSelect = True If .Show = -1 Then For Each vrtSelectedItem In .SelectedItems Set wdDoc = Documents.Open(FileName:=vrtSelectedItem) Set wbXL = ThisWorkbook 'This part specifies the Word Legacy Text Form Fields to be updated With wdDoc .wdtxtbxSWMSNumber.Text = UserForm1.txtSWMSNumber.Text 'This is an ActiveX text box in the Header .FormFields("wdfldProjectName").Result = UserForm1.txtProjectName.Text .FormFields("wdfldPrimaryContract").Result = UserForm1.txtPrimaryContractor.Text .FormFields("wdfldProjectAddress").Result = UserForm1.txtProjectAddress.Text .FormFields("wdfldPreparedBy").Result = UserForm1.txtPreparedBy.Text .FormFields("wdfldPreparedByDate").Result = UserForm1.txtDatePreparation.Text .FormFields("wdfldPreparedFor").Result = UserForm1.txtPreparedForN.Text .FormFields("wdfldDateSubmission").Result = UserForm1.txtDateSubmission.Text .FormFields("wdfldOnsiteRep").Result = UserForm1.txtOnsiteRep.Text .FormFields("wdfldReleasedBy").Result = UserForm1.txtAcceptedBy.Text 'This part generates the new file name from the Excel userform data and a Word bookmark and the ActiveX Text Box FileName = "SWMS " & .wdtxtbxSWMSNumber.Text & " " & _ .Bookmarks("SWMSType").Range.Text & " - " & _ .FormFields("wdfldPrimaryContract").Result & " - " & _ .FormFields("wdfldProjectName").Result .BuiltinDocumentProperties("Title") = FileName .BuiltinDocumentProperties("Subject") = .Bookmarks("SWMSType").Range.Text With Dialogs(wdDialogFileSaveAs) .Name = Fldr & "\" & FileName & ".pdf" .Format = wdFormatPDF .Execute End With .Close SaveChanges:=False End With Next End If End With 'this brings the msg box to foreground AppActivate Application.Caption MsgBox "Please remember to secure the PDF before sending", vbExclamation, "Task Complete" Call Shell("explorer.exe " & Fldr, vbNormalFocus) 'ActiveDocument.Close SaveChanges:=False Set MailObject = Outlook.CreateItem(olMailItem) With MailObject .To = UserForm1.txtPreparedForE.Text .CC = "" .BCC = "" .Subject = "SRC Safety Pack Bundle for" & " " & UserForm1.txtPrimaryContractor.Text .Body = "Hello" & " " & UserForm1.txtPreparedForN.Text & "," & vbNewLine & vbNewLine '.Attachments.Add .Display End With 'this brings the msg box to foreground AppActivate Application.Caption MsgBox "Please remember to examine the attachments before sending", vbExclamation, "Bunny Check..." 'I am unsure about this but it seems it is required Set SWMSsht = Nothing Set HSRAsht = Nothing Set PlantRAsht = Nothing Set MailObject = Nothing 'ActiveWorkbook.Close SaveChanges:=True 'Unload Me I am thinking I will need to loop through the .vrtSelectItems FileName.Name but the syntax and underpinning knowledge is beyond me. A gentle nudge towards a solution will be appreciated. Cheers Simon |
#2
|
|||
|
|||
![]()
I have a solution;
Create the MailObject prior to selecting the target folders then MailObject.Attachments.Add in the loop that updates and saves the pdfs using the string in .FileName. |
![]() |
|
![]() |
||||
Thread | Thread Starter | Forum | Replies | Last Post |
![]() |
Peter Carter | Word VBA | 27 | 12-15-2022 04:10 PM |
![]() |
Ahmed AbuZekry | Word VBA | 2 | 03-23-2015 02:14 AM |
Multiple contact select | pix42 | Outlook | 0 | 08-30-2013 01:55 AM |
![]() |
mapl | Excel | 2 | 06-14-2013 05:29 PM |
![]() |
Banker | PowerPoint | 1 | 08-15-2012 11:49 PM |