Thread: [Solved] vba code
View Single Post
 
Old 08-31-2017, 04:36 PM
sue68 sue68 is offline Windows 10 Office 2013
Novice
 
Join Date: Aug 2017
Posts: 1
sue68 is on a distinguished road
Default vba code

Hi

I have a word document that is currently set up for the workers to fill in and click the send and save button, this pdf's the page and publishes it to Sharepoint page and emails to a group email.
I need to add 2nd page which will not be pdf'd with the 1st page but will be sent as a 2 page word document to a email.

I'm not sure where to start with the below code.

1. How do I get the code to pick only the first page and not the second (will have workers private info on and is not for publishing)
2. Do I do the 2 page word doc first and then the pdf'ing

Code:
Option Explicit
Dim strFilename As String
Sub SaveAndSend()
    Dim strDate As String
    Dim strNoti As String
    Dim strTitle As String
    
    strDate = ActiveDocument.SelectContentControlsByTag("EventDate").Item(1).Range.Text
    
    If IsDate(strDate) Then
        strDate = Format(strDate, "yyyy-mm-dd")
    Else
        MsgBox "Please select an event date.", vbExclamation, "Date Error"
        Exit Sub
    End If
    
    strNoti = ActiveDocument.SelectContentControlsByTag("NotificationNumber").Item(1).Range.Text
    strTitle = ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).Range.Text
    
    If Not IsNumeric(strNoti) Or Len(strNoti) <> 9 Then
        MsgBox "Please enter a valid notification number.", vbExclamation, "Notification Error"
        Exit Sub
    End If
    
    If Left(strTitle, 5) = "Enter" Then
        MsgBox "Please enter short text.", vbExclamation, "Title Not Entered"
        Exit Sub
    End If
    
    
    
    strFilename = strDate & " " & strNoti & " " & strTitle & ".pdf"
    
    ActiveDocument.SaveAs FileName:= _
    "https://spo.bhpb.com/sites/COLMTAmac...Notifications/" & strFilename, FileFormat:=wdFormatPDF
    
    ActiveDocument.SaveAs FileName:= _
    "\\necmacfil01\bcc_data\Transfer\Sue Jones\NHSEC_DIR_CTRL_DOCS_(MRE)\" & strFilename, FileFormat:=wdFormatPDF
    
    Call SendDocumentAsAttachment
End Sub
Sub SendDocumentAsAttachment()
    Dim strDate As String
    Dim strNoti As String
    Dim strTitle As String
    
    strDate = ActiveDocument.SelectContentControlsByTag("EventDate").Item(1).Range.Text
    
    If IsDate(strDate) Then
        strDate = Format(strDate, "yyyy-mm-dd")
    Else
        MsgBox "Please select an event date.", vbExclamation, "Date Error"
        Exit Sub
    End If
    
    strNoti = ActiveDocument.SelectContentControlsByTag("NotificationNumber").Item(1).Range.Text
    strTitle = ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).Range.Text
    
    If Not IsNumeric(strNoti) Or Len(strNoti) <> 9 Then
        MsgBox "Please enter a valid notification number.", vbExclamation, "Notification Error"
        Exit Sub
    End If
    
    If Left(strTitle, 5) = "Enter" Then
        MsgBox "Please enter short text.", vbExclamation, "Title Not Entered"
        Exit Sub
    End If
    
    
    
    strFilename = strDate & " " & strNoti & " " & strTitle & ".pdf"
    
    Dim bStarted As Boolean
     
    Dim oOutlookApp As Outlook.Application
     
     'You'll need to add the Outlook Object Library to VBA Tools References
     
    Dim oItem As Outlook.MailItem
    strTitle = ActiveDocument.SelectContentControlsByTag("ShortText").Item(1).Range.Text
    
    On Error Resume Next
     
    ' If Len(ActiveDocument.Path) = 0 Then 'Document has not been saved
         
        'so save it
    ' ActiveDocument.Save
        
    ' End If
     
     'see if Outlook is running and if so turn your attention there
     
    Set oOutlookApp = GetObject(, "Outlook.Application")
     
    If Err <> 0 Then 'Outlook isn't running
         
         'So fire it up
         
        Set oOutlookApp = CreateObject("Outlook.Application")
         
        bStarted = True
         
    End If
     
     'Open a new e-mail message
     
    Set oItem = oOutlookApp.CreateItem(olMailItem)
     
    With oItem 'and add the detail to it
         
        .To = "DL-COL-NEC-MACEventNotification@bhpb.com" 'send to this address
        .CC = ""
         '.BCC = ""
         
        .Subject = strDate & " " & strNoti & " " & strTitle 'This is the message subject
         
        
        .Attachments.Add Source:="\\necmacfil01\bcc_data\Transfer\Sue Jones\NHSEC_DIR_CTRL_DOCS_(MRE)\" & strFilename
        .Display
         
    End With
     
   ' If bStarted Then 'If the macro started Outlook, stop it again.
         
   '     oOutlookApp.Quit
         
   ' End If
     
     'Clean up
     
    Set oItem = Nothing
     
    Set oOutlookApp = Nothing
     
End Sub

Last edited by macropod; 08-31-2017 at 04:51 PM. Reason: Added code tags to preserve code formatting
Reply With Quote