Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 07-01-2016, 03:58 PM
smndnm smndnm is offline Multiple Select .docx then SaveAs .pdf then email Windows 7 64bit Multiple Select .docx then SaveAs .pdf then email Office 2010 64bit
Novice
Multiple Select .docx then SaveAs .pdf then email
 
Join Date: Jul 2014
Location: Queensland
Posts: 24
smndnm is on a distinguished road
Default Multiple Select .docx then SaveAs .pdf then email

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 can only take credit for copy paste from the internet and lots of guess work.
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
Reply With Quote
  #2  
Old 07-02-2016, 03:46 PM
smndnm smndnm is offline Multiple Select .docx then SaveAs .pdf then email Windows 7 64bit Multiple Select .docx then SaveAs .pdf then email Office 2010 64bit
Novice
Multiple Select .docx then SaveAs .pdf then email
 
Join Date: Jul 2014
Location: Queensland
Posts: 24
smndnm is on a distinguished road
Default

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.
Reply With Quote
Reply



Similar Threads
Thread Thread Starter Forum Replies Last Post
Multiple Select .docx then SaveAs .pdf then email Run a macro on multiple docx. files Peter Carter Word VBA 27 12-15-2022 04:10 PM
Multiple Select .docx then SaveAs .pdf then email VBS saveas API behaviour is different from Menu saveas Ahmed AbuZekry Word VBA 2 03-23-2015 02:14 AM
Multiple contact select pix42 Outlook 0 08-30-2013 01:55 AM
Multiple Select .docx then SaveAs .pdf then email Batch convert multiple 32 bit xslx to 32 bit docx mapl Excel 2 06-14-2013 05:29 PM
Multiple Select .docx then SaveAs .pdf then email Select Multiple Objects in Powerpoint Banker PowerPoint 1 08-15-2012 11:49 PM

Other Forums: Access Forums

All times are GMT -7. The time now is 12:34 PM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2025, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2025 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft