Hello, I'm using the below code that I copied from another existing workbook, which automatically creates a pdf. file and generates an email in outlook express. It works perfectly on the existing workbook, but when I tried to copy it across to another workbook (changed relevant names) and ran the macro, it give me the following error:
"Compie error: User-defined type not defined", with this code hi-lighted in yellow: "Dim fso As FileSystemObject"
Can some one please tell me why this code is not working on this new workbook when it's essentially the same? I'm not familiar with the fso function so not sure what the error message means.
Thanks.
Other related code:
"Compie error: User-defined type not defined", with this code hi-lighted in yellow: "Dim fso As FileSystemObject"
Can some one please tell me why this code is not working on this new workbook when it's essentially the same? I'm not familiar with the fso function so not sure what the error message means.
Thanks.
Code:
Option Explicit
Public Sub CreatePDF(ws As Worksheet, sOutPath As String, sFileName As String)
Dim fso As FileSystemObject
Dim mbrRes As VbMsgBoxResult
Set fso = New FileSystemObject
If Right(sOutPath, 1) <> "\" Then
sOutPath = sOutPath & "\"
End If
If fso.FolderExists(sOutPath) Then
If fso.FileExists(sOutPath & sFileName) Then
mbrRes = MsgBox("File Already Exists! Would you like to overwrite?", vbYesNo, "Overwrite File?")
If mbrRes = vbNo Then
MsgBox "File Not Saved", vbCritical
GoTo exit_Sub
End If
End If
ws.Visible = xlSheetVisible
ws.ExportAsFixedFormat Type:=xlTypePDF, Filename:=sOutPath & sFileName, Quality:= _
xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, _
OpenAfterPublish:=True
ws.Visible = xlSheetHidden
Else
MsgBox sOutPath & " Not Found! File Not Saved.", vbCritical
GoTo exit_Sub
End If
exit_Sub:
On Error Resume Next
Set fso = Nothing
End Sub
Sub CreateMail(sRecipients As String, sCC As String, sBCC As String, _
sSubject As String, sAttach As String)
Dim oApp As Outlook.Application
Dim oMail As Outlook.MailItem
Dim sHTML As String
Dim sSigFile As Variant
Dim sSigHTML As String
Dim sSigPath As String
Dim fso As FileSystemObject
Dim reader As TextStream
Set fso = New FileSystemObject
'This section of the code attempts to grab an active outlook instance. If outlook is not open, the
'code opens outlook up.
On Error Resume Next
Set oApp = GetObject(, "Outlook.Application")
On Error GoTo 0
If oApp Is Nothing Then
Set oApp = CreateObject("Outlook.Application")
End If
'Start creating the email.
Set oMail = oApp.CreateItem(olMailItem)
'Get the sig
sSigPath = "C:\Documents and Settings\" & Environ("username") & _
"\Application Data\Microsoft\Signatures\"
sSigFile = Dir(sSigPath & "*.htm")
sSigFile = sSigPath & sSigFile
sSigHTML = ""
If fso.FileExists(sSigFile) Then
Set reader = fso.OpenTextFile(sSigFile)
sSigHTML = reader.ReadAll
reader.Close
Set reader = Nothing
End If
If sSigHTML = "" Then MsgBox "Signature not found, please insert manually.", vbCritical, "Error"
'Build the body of the email
sHTML = ""
'*************UPDATE LOGO PATH*********************************************************
sHTML = sHTML & "[IMG]http://www.mrexcel.com/forum/ & Chr(34) & [/IMG] '*************UPDATE LOGO PATH*********************************************************
sHTML = sHTML & "Please find the attached FX Advice.
"
sHTML = sHTML & "Please advise this office immediately if there are any discrepancies.
"
sHTML = sHTML & sSigHTML
sHTML = sHTML & ""
With oMail
.To = sRecipients
.CC = sCC
.BCC = sBCC
.Subject = sSubject
.Attachments.Add sAttach
.HTMLBody = sHTML
'Show the email.
.Display
End With
Set oMail = Nothing
Set oApp = Nothing
End Sub
Public Function MakeFolder(sPath As String, sFolderName As String) As String
Dim fso As FileSystemObject
Set fso = New FileSystemObject
'Check if the folder exists. If it doesn't, then create it.
If Not fso.FolderExists(sPath & sFolderName) Then
fso.CreateFolder (sPath & sFolderName)
End If
MakeFolder = sPath & sFolderName
Set fso = Nothing
End FunctionOther related code:
Code:
Public Sub Create_Advice()
Application.ScreenUpdating = False
Const FM_ROOT_FOLDER As String = "S:\FMS\FMS - Foreign Exchange\FMS - Fund Manager\"
Const CLIENT_ROOT_FOLDER As String = "S:\FMS\FMS - Foreign Exchange\FMS - Clients & Investment Mgers\"
Const FX_ADVICE_FOLDER As String = "FX Advices"
Dim wsAdvice As Worksheet
Dim wsRef As Worksheet
Dim sValue As String
Dim iRow As Integer
Dim iStart As Integer
Dim iEnd As Integer
Dim sClientName As String
Dim sYear As String
Dim sMonth As String
Dim sOutPath As String
Dim sPDFFileName As String
Dim dtTradeDate As Date
Dim sRootFolder As String
Set wsAdvice = Sheets("FX Advice S")
Set wsRef = Sheets("Reference")
'Trade Date from advice
dtTradeDate = wsAdvice.Range("rTradeDate").Value2
'Client Name = Used for folder generation/saving PDF
sClientName = wsAdvice.Range("rClientname").Value2
'Check whether fund manager or client and set root directory
If Application.WorksheetFunction.VLookup(sClientName, wsRef.Range("A:F"), 6, False) = "F" Then
sRootFolder = FM_ROOT_FOLDER
Else
sRootFolder = CLIENT_ROOT_FOLDER
End If
'Check if Client Folder exists.
MakeFolder sRootFolder, sClientName
'Check if FX Advice Folders exists.
MakeFolder sRootFolder & sClientName & "\", FX_ADVICE_FOLDER
'Check if year folder exists.
sYear = Format(Now(), "YYYY")
MakeFolder sRootFolder & sClientName & "\" & FX_ADVICE_FOLDER & "\", sYear
'Check if month folder exists.
sMonth = Format(Now(), "MMM YYYY")
sOutPath = MakeFolder(sRootFolder & sClientName & "\" & FX_ADVICE_FOLDER & "\" & sYear & "\", sMonth)
'Check if Client Folder Exists.
'MakeFolder ROOT_FOLDER, sClientName
'Check if year folder exists.
'sYear = Format(Now(), "YYYY")
'MakeFolder ROOT_FOLDER & sClientName & "\", sYear
'Check if month folder exists.
'sMonth = Format(Now(), "MMM YY")
'sOutPath = MakeFolder(ROOT_FOLDER & sClientName & "\" & sYear & "\", sMonth)
'Create the PDF
'File Name
sPDFFileName = "FX Advice - " & sClientName
sPDFFileName = sPDFFileName & " TD" & Format(Now() - (8 / 24), " DD.MM.YY HHMM")
sPDFFileName = sPDFFileName & ".pdf"
'sPDFFileName = "FX Advice " & "-" & sClientName
'sPDFFileName = sPDFFileName & "-" & Format(Now(), "DDMMYY_HHMM")
'sPDFFileName = sPDFFileName & ".pdf"
'Generate PDF (and open for preview)
CreatePDF wsAdvice, sOutPath, sPDFFileName
'Compile the email.
Dim sRecipients As String
Dim sCC As String
Dim sBCC As String
Dim sSubject As String
'Grab the recipient info
sRecipients = Application.WorksheetFunction.VLookup(sClientName, wsRef.Columns("A:D"), 2, False)
sCC = Application.WorksheetFunction.VLookup(sClientName, wsRef.Columns("A:D"), 3, False)
sBCC = Application.WorksheetFunction.VLookup(sClientName, wsRef.Columns("A:D"), 4, False)
'Build the subject
sSubject = "FX Advice - " & sClientName & " TD " & Format(Now() - (8 / 24), "DD/MM/YYYY")
'sSubject = "FX Advice - " & sClientName & " TD " & Format(dtTradeDate, "DD/MM/YYYY")
'Create the email
CreateMail sRecipients, sCC, sBCC, sSubject, sOutPath & sPDFFileName
Application.ScreenUpdating = True
'Exit Workbook
ThisWorkbook.Close (False)
End Sub
