Visual Basic Error 52 Bad File Name

Posted on 2011-02-11
Last Modified: 2012-05-11
Trying to find out why i'm getting this error when generating an order in a form within MS Access database.

I get a Visual basic run time error 52 bad file name and number.

When I try to debug it, it highlights a string of code on line 174...

If Dir (strPTH) = "\" Then

Full code is attached

ption Compare Database

Private Sub btn_IMCOM_Click()

Dim objWKB As Excel.workbook
Dim objWKS As Excel.worksheet

Dim strTMP As String    'IMCOM Template File
Dim strOTP As String    'IMCOM Output File

Dim strJUL As String    'Order Julian Date
Dim intONS As Integer   'Order Number Srart #
Dim intONC As Integer   'Count of Orders For day
Dim dteODT As Date      'Order Date
Dim strAKO As String    'UserID
Dim strEML As String    'IMCOM email address

Dim nbrROW As Long

Dim rst As Recordset

Dim db As Database

Set db = CurrentDb

Set rst = db.OpenRecordset("qry_IMCOM_request")

strAKO = Environ("UserName")

db.Execute ("DELETE * FROM [code Order]")

db.Execute ("INSERT INTO [Code Order] (OrderDt, OrderNbr) SELECT '" & Me.OrderDt & "', '" & Me.OrderNbr & "'")

strEML = DLookup("[IMCOMemail]", "Code Email", "IMCOMemail <> null")

If Right(strTMP, 1) <> "/" Then
    strTMP = strTMP & "/IMCOM_Template.xls"
    strTMP = strTMP & "IMCOM_Template.xls"
End If

strOTP = "C:\Users\" & strAKO & "\Desktop\IMCOM Request " & Me.OrderJulian & "-" & Me.OrderNbr & ".xls"

FileCopy strTMP, strOTP

Set appEXCEL = New Excel.Application
appEXCEL.Visible = True
Set objWKB = appEXCEL.Workbooks.Open(strOTP)

With rst
    nbrROW = 2
    Do Until rst.EOF
        With objWKB.Sheets("Template")
            .Cells(nbrROW, 1).Value = rst.Fields("Control Number").Value
            .Cells(nbrROW, 2).Value = rst.Fields("MOB or TCS Orders").Value
            .Cells(nbrROW, 3).Value = rst.Fields("LAST NAME").Value
            .Cells(nbrROW, 4).Value = rst.Fields("FIRST").Value
            .Cells(nbrROW, 5).Value = rst.Fields("SSN").Value
            .Cells(nbrROW, 6).Value = rst.Fields("IMCOM Date Process").Value
            .Cells(nbrROW, 7).Value = rst.Fields("Order#").Value
            .Cells(nbrROW, 8).Value = rst.Fields("Duty Loc").Value
            .Cells(nbrROW, 9).Value = rst.Fields("Days").Value
            .Cells(nbrROW, 10).Value = rst.Fields("Deploy Dt").Value
            .Cells(nbrROW, 11).Value = rst.Fields("Return Dt").Value
            .Cells(nbrROW, 12).Value = rst.Fields("UIC").Value
            .Cells(nbrROW, 13).Value = rst.Fields("Unit Name").Value
            .Cells(nbrROW, 14).Value = rst.Fields("COMP").Value
            .Cells(nbrROW, 15).Value = rst.Fields("Mob Stn").Value
            .Cells(nbrROW, 16).Value = rst.Fields("SDN").Value
            .Cells(nbrROW, 17).Value = rst.Fields("Fund Cite").Value
            .Cells(nbrROW, 18).Value = rst.Fields("CIC").Value
            .Cells(nbrROW, 19).Value = rst.Fields("Is this an amendment?").Value
            .Cells(nbrROW, 20).Value = rst.Fields("Original Order #").Value
            .Cells(nbrROW, 21).Value = rst.Fields("Cost").Value
        End With
        nbrROW = nbrROW + 1
End With


On Error GoTo err_email

MsgBox ("REMINDER!!!!" & Chr(10) & "This email must be sent encrypted.")

Set appOUTLOOK = New Outlook.Application
Set objMAIL = appOUTLOOK.createitem(olMailItem)
With objMAIL
    .Recipients.Add strEML
    .Subject = "TCS Orders Fund Cite Request Order Number " & Me.OrderJulian & "-" & Me.OrderNbr & " departing on " & Me.DeployDt
    .Body = "Attached is a request for fund cite for " & Me.Unit & " departing the installation on " & Me.DeployDt & "."
    .Attachments.Add strOTP
End With

db.Execute ("UPDATE tbl_OrderLog SET tbl_OrderLog.IMCOMDt = Now() WHERE tbl_OrderLog.OrderDt= #" & Me.OrderDt & "# AND tbl_OrderLog.OrderNbr = '" & Me.OrderNbr & "'; ")


DoCmd.OpenForm ("frm_OrderLog")

Exit Sub

    MsgBox ("Email was not sent!")
    Exit Sub
    Resume Next

End Sub

Private Sub Form_Load()

Dim strJUL As String
Dim dteODT As Date

Dim intCNT As Integer       'Length of Field

If Me.OpenArgs <> "" Then
    DoCmd.GoToRecord , , acNewRec
    Me.OrderType = "AMEND"
    Me.OrderCreator = Environ("USERNAME")
    intCNT = Len(Me.OpenArgs)
    Me.OriginalOrderDt = Left(Me.OpenArgs, (intCNT - 7))
    Me.OriginalOrderJulian = Mid(Me.OpenArgs, (intCNT - 5), 3)
    Me.OriginalOrderNbr = Right(Me.OpenArgs, 3)
    Me.OrderDt = Date
    strJUL = (DateDiff("d", "1/1/" & DatePart("YYYY", Me.OrderDt), Me.OrderDt)) + 1

    If Len(strJUL) = 1 Then strJUL = "00" & strJUL
    If Len(strJUL) = 2 Then strJUL = "0" & strJUL

    Me.OrderJulian = strJUL
    dteODT = Me.OrderDt
    intONS = DLookup("[OrderNbrSt]", "Code OrderNbr", "OrderNbrSt <> null")
    intONC = DCount("[OrderType]", "tbl_OrderLog", "OrderDt = #" & dteODT & "#")

    Me.OrderNbr = intONS + intONC
    Me.ControlType = DLookup("[ControlType]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.DutyLocation = DLookup("[DutyLocation]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.Days = DLookup("[Days]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.DeployDt = DLookup("[DeployDt]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.ReturnDt = DLookup("[ReturnDt]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.Unit = DLookup("[Unit]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.ParaLineNbr = DLookup("[ParaLineNbr]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.Component = DLookup("[Component]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
    Me.MobStn = DLookup("[MobStn]", "tbl_OrderLog", "OrderDt = #" & Me.OriginalOrderDt & "# and OrderNbr = '" & Me.OriginalOrderNbr & "'")
End If


End Sub

Private Sub Order_Click()

Dim intCNT As Integer       'Count of Personnel on order

Dim strPTH As String

Dim db As Database

Set db = CurrentDb

'Gets FileLocation, determines if it exists and creates if does not
strPTH = DLookup("[FileLocationPath]", "Code FileLocation", "FileLocationPath <> ''")
If Right(strPTH, 1) <> "\" Then strPTH = strPTH & "\"
strPTH = strPTH & DatePart("yyyy", Me.OrderDt) & "\"
If Dir(strPTH) = "\" Then MkDir strPTH
'Delets all information from [Code Order] and repopulates it with current order information
db.Execute "DELETE * FROM [CODE ORDER]; "

db.Execute "INSERT INTO [Code Order] ( OrderDt, OrderNbr ) SELECT #" & Me.OrderDt & "#, '" & Me.OrderNbr & "'; "
'Determines which order style to create and exports report to PATH in pdf.
intCNT = DCount("[SSN]", "tbl_OrderInformation", "[OrderDt] = #" & Me.OriginalOrderDt & "# and [OrderNbr] = '" & Me.OriginalOrderNbr & "'")

If intCNT = 1 Then
    DoCmd.OutputTo acOutputReport, "rpt_AmendOrders(Indiv)", acFormatPDF, strPTH & Me.OrderJulian & "-" & Me.OrderNbr & ".pdf"
    DoCmd.OpenReport "rpt_AmendOrders(Indiv)", acViewPreview
End If
If intCNT > 1 Then
    DoCmd.OutputTo acOutputReport, "rpt_AmendOrders(Mass)", acFormatPDF, strPTH & Me.OrderJulian & "-" & Me.OrderNbr & ".pdf"
    DoCmd.OpenReport "rpt_AmendOrders(Mass)", acViewPreview
End If
If intCNT = 0 Then MsgBox ("No personnel listed on order.")


End Sub

Open in new window

Question by:nellafurtado
  • 8
  • 4
  • 4
  • +3

Author Comment

ID: 34875396
Not sure if this helps but it is MS Access front end and SQL Server backend.


Expert Comment

ID: 34875483
\ is a path separator not a path itself. What is the value of strPTH after row 173?
LVL 119

Expert Comment

by:Rey Obrero
ID: 34875492
change this

If Dir (strPTH) = "\" Then


If Dir (strPTH,vbdirectory) = "" Then

Author Comment

ID: 34875945
Why all of a sudden would the code change? It used to work.  

Not able to check to see if that works yet Capricorn1 and Toxacon. The database is at work, i'll test it again on Monday with your suggestions and let you know how it turns out.

Thanks for such a quick reply!
LVL 31

Expert Comment

ID: 34876041
Here is an alternate method for determining whether a folder exists, and creating it if not (using elements of the FileSystem Object):
Dim fso As Scripting.FileSystemObject
   Dim fld As Scripting.Folder
   Dim strFolderPath as String


   'Check that there is a ___________ folder, and create it if not found
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set fld = fso.GetFolder(strFolderPath)

   If Err.Number = 76 Then
      Set fld = fso.CreateFolder(strFolderPath)
      Resume Next
      MsgBox "Error No.: " & Err.Number & "; Description: " & Err.Description
      Resume ErrorHandlerExit
   End If

Open in new window

LVL 31

Expert Comment

ID: 34876045
The above code needs a reference to the Microsoft Scripting Runtime library
LVL 45

Expert Comment

ID: 34876866
There are much faster ways of getting data into an Excel workbook.

If your recordset is ADO, you can use the CopyFromRecordset method.

Please read my Fast Data Push to Excel article:
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 334 total points
ID: 34878429
As the HELP system defines Dir Function

Returns a String representing the name of a file, directory, or folder that matches a specified pattern or file attribute, or the volume label of a drive.

Dir[(pathname[, attributes])]

The Dir function syntax has these parts:
pathname (Optional).String expression that specifies a file name — may include directory or folder, and drive. A zero-length string ("") is returned if pathname is not found.

attributes (Optional).Constant or numeric expression, whose sum specifies file attributes. If omitted, returns files that match pathname but have no attributes

That being said the test in line should be:

   If Dir(strPTH) = "" Then MkDir strPTH

I find string tests are unreliable sometimes so the best bet is to change it to:

   If len(Trim(Dir(strPTH))) = 0 Then MkDir strPTH

Why it has worked in the past and not now I could only put down to the test always testing FALSE in the past, which means the Folder has always existed.

Another possibility is the value of strPTH is not in the valid format for a Folder Path and name. Check in the debugger to ascertain the value of strPTH. That may lead you to the solution to why this error is happening.

Author Comment

ID: 34882265
Thanks everyone, i'll Try these on Monday when I get back to work and see which will work.

Author Comment

ID: 34888577
Guys I narrowed it down to this...

We switched servers a few days ago and the server path has changed. Where do I go in the code (what line) to change "strPTH" to reflect the new server path?

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

LVL 119

Assisted Solution

by:Rey Obrero
Rey Obrero earned 166 total points
ID: 34888607
open table Code FileLocation and update the FileLocationPath field

strPTH = DLookup("[FileLocationPath]", "Code FileLocation", "FileLocationPath <> ''")

Author Comment

ID: 34889008

I'm very new to visual basic, how do I find the table code FileLocation?  I'm not seeing another table of code that's named "filelocation" to open up and edit.

LVL 119

Expert Comment

by:Rey Obrero
ID: 34889045
the table name is  "Code FileLocation"
LVL 31

Expert Comment

ID: 34889062
A general comment -- the code is very old, ca. Access 95 vintage.  It could (and probably should) be updated to use such features as named arguments, the FileDialog object, and probably recordsets instead of the numerous DLookup lines.
LVL 31

Expert Comment

ID: 34889116
And I agree with aikimark about using CopyFromRecordset to get Access data into Excel.  Here is some code:
Dim appExcel As New Excel.Application
   Dim cnn As ADODB.Connection
   Dim wkb As Excel.Workbook
   Dim sht As Excel.Worksheet
   Dim strWorkbook As String
   Dim strRange As String
   Dim lngLastRow As Long
   Dim rst As ADODB.Recordset
   Dim rng As Excel.Range
   Dim strWorkbookName As String
   Dim strDefault As String
   DoCmd.SetWarnings False
   strPrompt = "Enter workbook name (no extension)"
   strTitle = "Workbook name"
   strDefault = "New Access Data"
   strWorkbookName = InputBox(strPrompt, strTitle, strDefault)
   Set cnn = CurrentProject.Connection
   Set rst = New ADODB.Recordset
   'Create a recordset based on a select query.
   rst.Open Source:="qryContacts", _
      ActiveConnection:=cnn.ConnectionString, _
   'Export query data to Excel workbook
   Set wkb = appExcel.Workbooks.Add
   appExcel.Visible = True
   strWorkbook = Application.CurrentProject.Path & "\" & strWorkbookName
   wkb.SaveAs FileName:=strWorkbook
   Set sht = wkb.Sheets(1)
   strRange = "A1"
   Set rng = sht.Range(strRange)
   rng.CopyFromRecordset rst

Open in new window

LVL 13

Accepted Solution

Chris Raisin earned 334 total points
ID: 34889313
The line where the value  is determined by the program is line 171

      strPTH = DLookup("[FileLocationPath]", "Code FileLocation",  _
                                    "FileLocationPath <> ''")
This code means "do a Data lookup in the table "FileLocationPath" and look for the value "Code LocationFile". If no value is found, return the value NULL to strPTH
else return the value found (also return NULL if an empty string is recorded).

You COULD be quick and dirty and hard code the path into this line such as:
      strPTH = "F:\Data\"
but it is MUCH better to leave the code as it is and simply change the path in the
table name "FileLocationPath". You will need to go into that table to change the value.
Using Access frontend, find the Table within the database and change the value there.
I cannot ascertain the name of the database, since your code simply opens "CurrentDb" (the currently opened database). Hope that helps.
LVL 119

Expert Comment

by:Rey Obrero
ID: 34889340
<This code means "do a Data lookup in the table "FileLocationPath" and look for the value "Code LocationFile". If no value is found, return the value NULL to strPTH>


the domain is  "Code LocationFile"
do a Data lookup in the table   "Code LocationFile"  and look for the value in field "FileLocationPath"

Author Comment

ID: 34889416
Do I need to look on the SQL server for the table "Code FileLocation". Is that where I need to go to change the code to reflect the new file location?

Helen, I inherited this access front end and SQL backend database from another person that was before me. I'm trying to learn the VB as i'm debugging, still trying to figure out how everything comes together. Once I get this fixed, i'll look at updating the code!


Author Comment

ID: 34889637
Trying Craisin's solution. Didn't see it posted before I posted my last comment....

Author Closing Comment

ID: 34889880
Excellent solution everyone. The next question I post I am going to state up front that i'm very new to VB so you guys can break it down in baby steps like you did.

I appreciate it!


Featured Post

PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
Learn how to number pages in an Access report over each group. Activate two pass printing by referencing the pages property: Add code to the Page Footers OnFormat event to capture the pages as there occur for each group. Use the pages property to …
With Microsoft Access, learn how to specify relationships between tables and set various options on the relationship. Add the tables: Create the relationship: Decide if you’re going to set referential integrity: Decide if you want cascade upda…

937 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

3 Experts available now in Live!

Get 1:1 Help Now