Linking Multiple VBA macros across a few Office applications together?

[Stildawn]

Hi All

This I think is a bit of a tricky one I have a few sets of code I want to link together seamlessly.

These two codes I have writen in Outlook:

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String
' Get the path to your folder
strFolderpath = "C:\Users\tbaker\Documents\Jobs\"
On Error Resume Next
' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")
' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection
' Set the Attachment folder.
job = InputBox("Enter Job Number")
MkDir strFolderpath & job
strFolderpath = strFolderpath & job & "\"
' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder
For Each objMsg In objSelection
' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""
If lngCount > 0 Then
For i = lngCount To 1 Step -1
    ' Save attachment before deleting from item.
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

Next i
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing
End Sub

This one saves all the attachments from a selected email into a new folder the user creates (with the inputbox for job number).

Sub Opentemplate()
Dim word As Object
Set word = CreateObject("Word.Application")
Template = "C:\Users\tbaker\Documents\Template.docm"
MsgBox ("Set Windows focus on Logis, then click ALT+PRINT SCREEN, then click OK below")
With word
    .Documents.Open (Template)
    .Visible = True
End With
End Sub

This one directs the user to take a screenshot of the program "logis" and then simply opens a word template document .

Now we move to the Word template code here:

Sub Document_Open()Screen_Capture_VBA
 
End Sub

This runs the word macro below on document opening.

Sub Screen_Capture_VBA()
 Selection.Paste
 
 Dim job As String
 job = InputBox("Enter Job Number")
 Dim DocName As String
 DocName = "C:\Users\tbaker\Documents\Jobs\" & job & "\" & job & ".pdf"
 ActiveDocument.SaveAs FileName:=DocName, FileFormat:=wdFormatPDF 
End Sub

This justs pastes the captured screen shot into the word doc and saves it as a PDF. Here is my first problem, you see there is the job number inputbox again, is there a way for this macro to use the already set job number (and hence the correct folder to save the pdf to) from the code in Outlook?

Moving on, once this is done there should be a bunch of attachments and this new pdf in the created "job number" folder.

I then have this code which basically just sends a blank email to an address with attachments:

temp = "C:\Users\tbaker\Documents\Jobs\" & job & "\" & job & ".pdf" 'this is the pdf created in word, again you see I need to get the job number from way back at the beginning

Dim objOutl
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
Application.ScreenUpdating = False
ans = MsgBox("Do you need to add any more attachments?", vbYesNo)
If ans = vbYes Then
    AttachFileName = Application.GetOpenFilename("Files (*.**)," & _
     "*.**", 1, "Select File", "Open", True)
strEmailAddr = [EMAIL="email.address@domain.com"]email.address@domain.com[/EMAIL]
objMailItem.Recipients.Add strEmailAddr
objMailItem.Body = ""
objMailItem.Subject = ""
objMailItem.Attachments.Add temp
For a = LBound(AttachFileName) To UBound(AttachFileName)
    objMailItem.Attachments.Add AttachFileName(a)
 Next
 objMailItem.Send
End If
Set objMailItem = Nothing
Set objOutl = Nothing
Application.ScreenUpdating = True

This is fine, however I have one extra question, what code could I use to attach all the files in the job number folder to the email? There could be many files in the folder?


And thats where I am, need to put all the above together (with the fixes) so that it can all run from a button in outlook.

Many thanks in advance.

Cheers

 

[Stildawn]

Thinking about this, could I do all the code in one big Outlook sub, using a boat load of with blocks to do the various things in Word etc?

 

[Norie]

You could do it all in Outlook, don't know why you would need a load of With blocks though.

This code could go directly into Outlook VBA.

Sub Opentemplate()
Dim word As Object
Set word = CreateObject("Word.Application")
Template = "C:\Users\tbaker\Documents\Template.docm"
MsgBox ("Set Windows focus on Logis, then click ALT+PRINT SCREEN, then click OK below")
With word
    .Documents.Open (Template)
    .Visible = True
End With
End Sub

If you did that you could then simply call it from the main Outlook sub.

Call OpenTemplate

That might be all you need actually, as when the template is opened the Document Open event wil be triggered and the Screen_Capture sub executed.

 

[Stildawn]

Ok I'll see if I can figure that out, but how do I handle the job number issue? I only want the user to be prompted for a job number once and for it to be used throughout.

 

[Stildawn]

Hi Everyone, I have tried linking this together in this code within Outlook:

Public Sub SaveAttachments()
Dim objOL As Outlook.Application
Dim objMsg As Outlook.MailItem 'Object
Dim objAttachments As Outlook.Attachments
Dim objSelection As Outlook.Selection
Dim i As Long
Dim lngCount As Long
Dim strFile As String
Dim strFolderpath As String
Dim strDeletedFiles As String

' Get the path to your folder
strFolderpath = "C:\Users\tbaker\Documents\Jobs\"
On Error Resume Next

' Instantiate an Outlook Application object.
Set objOL = CreateObject("Outlook.Application")

' Get the collection of selected objects.
Set objSelection = objOL.ActiveExplorer.Selection

' Set the Attachment folder.
job = InputBox("Enter Job Number")
MkDir strFolderpath & job
strFolderpath = strFolderpath & job & "\"

' Check each selected item for attachments. If attachments exist,
' save them to the strFolderPath folder
For Each objMsg In objSelection

' This code only strips attachments from mail items.
' If objMsg.class=olMail Then
' Get the Attachments collection of the item.
Set objAttachments = objMsg.Attachments
lngCount = objAttachments.Count
strDeletedFiles = ""
If lngCount > 0 Then
For i = lngCount To 1 Step -1
    ' Save attachment before deleting from item.
    ' Get the file name.
    strFile = objAttachments.Item(i).FileName
    ' Combine with the path to the Temp folder.
    strFile = strFolderpath & strFile
    ' Save the attachment as a file.
    objAttachments.Item(i).SaveAsFile strFile

Next i
End If
Next
ExitSub:
Set objAttachments = Nothing
Set objMsg = Nothing
Set objSelection = Nothing
Set objOL = Nothing


'Delete here down to return to normal working order


Dim word As Object
Set word = CreateObject("Word.Application")

MsgBox ("Set Windows focus on Logis, then click ALT+PRINT SCREEN, then click OK below")

With word
    .Documents.Add
    .Visible = True
    .Selection.Paste
    Dim DocName As String
    DocName = "C:\Users\tbaker\Documents\Jobs\" & job & "\" & job & ".pdf"
    .ActiveDocument.SaveAs2 FileName:=DocName, FileFormat:=wdFormatPDF
End With


temp = "C:\Users\tbaker\Documents\Jobs\" & job & "\" & job & ".pdf" 'this is the pdf created in word, again you see I need to get the job number from way back at the beginning
Dim objOutl
Set objOutl = CreateObject("Outlook.Application")
Set objMailItem = objOutl.CreateItem(olMailItem)
Application.ScreenUpdating = False
ans = MsgBox("Do you need to add any more attachments?", vbYesNo)
If ans = vbYes Then
    AttachFileName = Application.GetOpenFilename("Files (*.**)," & _
     "*.**", 1, "Select File", "Open", True)
strEmailAddr = "[EMAIL="email.address@domain.com"]email.address@domain.com[/EMAIL]"
objMailItem.Recipients.Add strEmailAddr
objMailItem.Body = ""
objMailItem.Subject = ""
objMailItem.Attachments.Add temp
For a = LBound(AttachFileName) To UBound(AttachFileName)
    objMailItem.Attachments.Add AttachFileName(a)
 Next
 objMailItem.Send
End If
Set objMailItem = Nothing
Set objOutl = Nothing
Application.ScreenUpdating = True

End Sub

First issue now is when I open up the created Job folder and try to open the new Job.pdf it doesn't open and Adobe Reader says: "Could not open as its not supported file type or is damanged"

Secondly everything after the word part doesn't seem to fire (even though there are no errors even when I F8 through it). Now email is created, nothing is attached, and nothing is sent... However the "ans = MsgBox("Do you need to add any more attachments?", vbYesNo)" box does come up.


Any help would be greatly appreciated.

Thanks

PS. I have checked the pdf file format on these two sites: http://msdn.microsoft.com/en-us/library/office/ff836084.aspx & http://msdn.microsoft.com/en-us/library/office/ff839952.aspx and it should be fine, though maybe its getting confused cause I'm doing all this within Outlook? Would Outlook have a different FileFormat for saving as PDF?

 

[Norie]

That doesn't look quite right.

You just seem to have put the Word code in the middle of the Outlook sub.

Also, you are creating 2 instances of Outlook, you should only need 1.

 

[Stildawn]

I'm sure I am doing it wrong. I'm trying to get around having to put the job number in twice. Just found out that outlook can't save as PDF anyway so doing it all in outlook code isn't going to work.

 

[Norie]

I wasn't suggesting you do the PDF part with Outlook, you'lll need to do that with Word using the code you already have.

One thing you'll need to do if putting the Word code in Outlook is to declare constants like this.

Const wdFormatPDF = 17

That would go at the top of the module.

 

[Stildawn]

I have redone it all so that the first two codes run in Outlooks (so Public Sub SaveAttachments() & Sub Opentemplate() both run one after the other in Outlook). The Word document then opens running the Sub Screen_Capture_VBA() code. However as you can see the job variable is defined both in Public Sub SaveAttachments() (in Outlook) as well as in Sub Screen_Capture_VBA() (in Word). Is there a way for the job variable from Outlook to be used in the Word VBA? That way it would save the user entering it twice. Also the create email code now runs in Word also (after the screen capture one), I still haven't figured out how to attach all files in a folder though.