File System Object Error

Aviles

Board Regular
Joined
Dec 17, 2008
Messages
141
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.

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 Function
Other 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
 

Trevor G

Well-known Member
Joined
Jul 17, 2008
Messages
6,362
Take a look at the Reference as you must have set them in the first workbook.

Open the workbook and Go Into VBA (Alt + F11) then Select Tools Menu > Reference and check the reference has been ticked.
 

Aviles

Board Regular
Joined
Dec 17, 2008
Messages
141
You're right... these were set up the first time.
Thanks Trevor!!
 

Jon von der Heyden

MrExcel MVP, Moderator
Joined
Apr 6, 2004
Messages
10,709
Office Version
365
Platform
Windows
Or change it to late bound:

Code:
Option Explicit
Public Sub CreatePDF(ws As Worksheet, sOutPath As String, sFileName As String)
 
  Dim fso As [B]Object[/B] 'FileSystemObject
  Dim mbrRes As VbMsgBoxResult
 
  Set fso = [B]CreateObject("Scripting.FileSystemObject")[/B] 'New FileSystemObject
 

Forum statistics

Threads
1,081,767
Messages
5,361,164
Members
400,617
Latest member
barron1

Some videos you may like

This Week's Hot Topics

  • populate from drop list with multiple tables
    Hi All, i have a drop list that displays data, what i want is when i select one of those from the list to populate text from different tables on...
  • Find list of words from sheet2 in sheet1 before a comma and extract text vba
    Hi Friends, Trying to find the solution on my task. But did not find suitable one to the need. Here is my query and sample file with details...
  • Dynamic Formula entry - VBA code sought
    Hello, really hope one of you experts can help with this - i've spent hours on this and getting no-where. .I have a set of data (more rows than...
  • Listbox Header
    Have a named range called "AccidentsHeader" Within my code I have: [CODE]Private Sub CommandButton1_Click() ListBox1.RowSource =...
  • Complex Heat Map using conditional formatting
    Good day excel world. I have a concern. Below link have a list of countries that carries each country unique data. [URL...
  • Conditional formatting
    Hi good morning, hope you can help me please, I have cells P4:P54 and if this cell is equal to 1 then i want row O to say "Fully Utilised" and to...
Top