Hello,
I've been working on this ultimate macro for days. I've been using Ron de Bruin's macros from his site (http://www.rondebruin.nl), but I have some issues. I can't get it to work properly.
First off, my macro creates a PDF file for my workbook. First problem here is that it creates a PDF of all sheets, not just the active one. I will never ever have to create a PDF of any other sheets than the very first one (called "Blad1" in my workbook).
However, the macro lets me save the PDF file as and attaches it to a new e-mail in Microsoft Office Outlook 2007 (edited in HTML-format). Everything works fine, until I take a look at the signature. Here something peculiar happens. The logotype (a .jpg-file) looks broken. I have attached the htm-document according to Ron de Bruin's code, and I have double and triple-checked the file paths. The htm-document itself works fine.
All I could find out when looking for any obvious errors was when I saved the e-mail as a HTML-file, opened in Internet Explorer and clicked "show source". Scrolling down to the bottom, I found something very strange. Here's what the lines look like in my original htm-document:
Everything works fine. The logotype called image001.jpg is located in the folder informell-filer.
In the source of the e-mail however, the same lines look like this:
Somehow the macro changes the folder name in the file path to the same as the subject of the e-mail, but still it's adding -filer (meaning -files).
I have no idea how to fix this, but I suspect there is something not right with the functions.
Here is the full code I use, called RDB_Workbook_To_PDF_And_Create_Mail_with_signature().
Not all functions are used but I decided to keep them since I might need them to merge together the codes and make the whole 'active sheet into PDF'-thing achievable.
I have Office 2007 and my Windows XP is in Swedish.
I am very thankful for any help! I've been resarching for solutions to these problems for days now.
Sincerely,
Amanda
<!--[endif]-->
I've been working on this ultimate macro for days. I've been using Ron de Bruin's macros from his site (http://www.rondebruin.nl), but I have some issues. I can't get it to work properly.
First off, my macro creates a PDF file for my workbook. First problem here is that it creates a PDF of all sheets, not just the active one. I will never ever have to create a PDF of any other sheets than the very first one (called "Blad1" in my workbook).
However, the macro lets me save the PDF file as and attaches it to a new e-mail in Microsoft Office Outlook 2007 (edited in HTML-format). Everything works fine, until I take a look at the signature. Here something peculiar happens. The logotype (a .jpg-file) looks broken. I have attached the htm-document according to Ron de Bruin's code, and I have double and triple-checked the file paths. The htm-document itself works fine.
All I could find out when looking for any obvious errors was when I saved the e-mail as a HTML-file, opened in Internet Explorer and clicked "show source". Scrolling down to the bottom, I found something very strange. Here's what the lines look like in my original htm-document:
PHP:
<v:imagedata src="informell-filer/image001.jpg" o:title="image001"/> </v:shape><![endif]--><![if !vml]><img width=346 height=77 src="informell-filer/image001.jpg" v:shapes="_x0000_i1025"><![endif]><o:p></o:p></span></p>Everything works fine. The logotype called image001.jpg is located in the folder informell-filer.
In the source of the e-mail however, the same lines look like this:
PHP:
</v:shape><![endif]--><![if !vml]><img width=346 height=77 src="This%20is%20the%20Subject%20line-filer/image001.gif" alt=image001 v:shapes="Bild_x0020_1"><![endif]><span style='color:navy;mso-no-proof:yes'><o:p></o:p></span></p>Somehow the macro changes the folder name in the file path to the same as the subject of the e-mail, but still it's adding -filer (meaning -files).
I have no idea how to fix this, but I suspect there is something not right with the functions.
Here is the full code I use, called RDB_Workbook_To_PDF_And_Create_Mail_with_signature().
PHP:
'Code to create a PDF and a Mail
'Only working if you use Outlook
Sub RDB_Workbook_To_PDF_And_Create_Mail_with_signature()
Dim FileName As String
Dim OutApp As Object
Dim OutMail As Object
On Error Resume Next
'Call the function with the correct arguments
FileName = RDB_Create_PDF(ActiveWorkbook, "", True, False)
'For a fixed file name and overwrite it each time you run the macro use
'RDB_Create_PDF(ActiveWorkbook, "C:\Users\Ron\Test\YourPdfFile.pdf", True, True)
If FileName <> "" Then
RDB_Mail_PDF_Outlook FileName, "ron@debruin.nl", "This is the subject", _
"See the attached PDF file with the last figures" _
& vbNewLine & vbNewLine & "Regards Ron de bruin", False
Else
MsgBox "Not possible to create the PDF, possible reasons:" & vbNewLine & _
"Microsoft Add-in is not installed" & vbNewLine & _
"You Canceled the GetSaveAsFilename dialog" & vbNewLine & _
"The path to Save the file in arg 2 is not correct" & vbNewLine & _
"You didn't want to overwrite the existing PDF if it exist"
End If
End Sub
Function GetBoiler(ByVal sFile As String) As String
'**** Kusleika
Dim fso As Object
Dim ts As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
GetBoiler = ts.readall
ts.Close
End Function
Sub Mail_Outlook_With_Signature_Html()
' Don't forget to copy the function GetBoiler in the module.
' Working in Office 2000-2010
Dim OutApp As Object
Dim OutMail As Object
Dim StrBody As String
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
OutApp.Session.Logon
Set OutMail = OutApp.CreateItem(0)
StrBody = "<H3><B>Dear Customer</B></H3>" & _
"Please visit this website to download the new version.<br>" & _
"Let me know if you have problems.<br>" & _
"<A HREF=""http://www.rondebruin.nl/tips.htm"">Ron's Excel Page</A>" & _
"<br><br><B>Thank you</B>"
'Use the second SigString if you use Vista as operating system
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signaturer\informell.htm"
'SigString = "C:\Users\" & Environ("username") & _
"\AppData\Roaming\Microsoft\Signatures\informell.htm"
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
On Error Resume Next
With OutMail
.To = "ron@debruin.nl"
.CC = ""
.BCC = ""
.Subject = "This is the Subject line"
.HTMLBody = StrBody & "<br><br>" & Signature
'You can add files also like this
'.Attachments.Add ("C:\test.txt")
.Display 'or use .Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub
'This are the functions that the macros above will use
'Do not forget to copy them in your module
Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
Dim FileFormatstr As String
Dim Fname As Variant
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
'Now the file name is correct we Publish to PDF
On Error Resume Next
Myvar.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
End If
End Function
Function RDB_Mail_PDF_Outlook(FileNamePDF As String, strto As String, _
StrSubject As String, StrBody As String, Send As Boolean)
Dim OutApp As Object
Dim OutMail As Object
Dim SigString As String
Dim Signature As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
SigString = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signaturer\informell.htm"
' Anpassad för winXP
If Dir(SigString) <> "" Then
Signature = GetBoiler(SigString)
Else
Signature = ""
End If
StrBody = "Här följer det senaste serviceprotokollet." & _
"<br>"
' Text included in e-mail
On Error Resume Next
With OutMail
.To = ThisWorkbook.Sheets("Blad1").Range("A1").Value
' find mail addesses, blad=sheet
.CC = ""
.BCC = ""
.Subject = "Senaste Serviceprotokoll"
.HTMLBody = StrBody & "<br><br>" & Signature
.Attachments.Add FileNamePDF
If Send = True Then
.Send
Else
.Display
End If
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Function
Function Create_PDF_Sheet_Level_Names(NamedRange As String, FixedFilePathName As String, _
OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
'This function will create a PDF with every sheet with
'a sheet level name variable <NamedRange> in it
Dim FileFormatstr As String
Dim Fname As Variant
Dim Ash As Worksheet
Dim sh As Worksheet
Dim ShArr() As String
Dim s As Long
Dim SheetLevelName As Name
'Test If the Microsoft Add-in is installed
If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
& Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then
'We fill the Array with sheets with the sheet level name variable
For Each sh In ActiveWorkbook.Worksheets
If sh.Visible = -1 Then
Set SheetLevelName = Nothing
On Error Resume Next
Set SheetLevelName = sh.Names(NamedRange)
On Error GoTo 0
If Not SheetLevelName Is Nothing Then
s = s + 1
ReDim Preserve ShArr(1 To s)
ShArr(s) = sh.Name
End If
End If
Next sh
'We exit the function If there are no sheets with
'a sheet level name variable named <NamedRange>
If s = 0 Then Exit Function
If FixedFilePathName = "" Then
'Open the GetSaveAsFilename dialog to enter a file name for the pdf
FileFormatstr = "PDF Files (*.pdf), *.pdf"
Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
Title:="Create PDF")
'If you cancel this dialog Exit the function
If Fname = False Then Exit Function
Else
Fname = FixedFilePathName
End If
'If OverwriteIfFileExist = False we test if the PDF
'already exist in the folder and Exit the function if that is True
If OverwriteIfFileExist = False Then
If Dir(Fname) <> "" Then Exit Function
End If
Application.ScreenUpdating = False
Application.EnableEvents = False
'Remember the ActiveSheet
Set Ash = ActiveSheet
'Select the sheets with the sheet level name in it
Sheets(ShArr).Select
'Now the file name is correct we Publish to PDF
On Error Resume Next
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
FileName:=Fname, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=OpenPDFAfterPublish
On Error GoTo 0
'If Publish is Ok the function will return the file name
If Dir(Fname) <> "" Then
Create_PDF_Sheet_Level_Names = Fname
End If
Ash.Select
Application.ScreenUpdating = True
Application.EnableEvents = True
End If
End FunctionNot all functions are used but I decided to keep them since I might need them to merge together the codes and make the whole 'active sheet into PDF'-thing achievable.
I have Office 2007 and my Windows XP is in Swedish.
I am very thankful for any help! I've been resarching for solutions to these problems for days now.
Sincerely,
Amanda
<!--[endif]-->
