Link to home
Start Free TrialLog in
Avatar of nellafurtado

asked on

Visual Basic Error 52 Bad File Name

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

Avatar of nellafurtado


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

\ is a path separator not a path itself. What is the value of strPTH after row 173?
Avatar of Rey Obrero (Capricorn1)
change this

If Dir (strPTH) = "\" Then


If Dir (strPTH,vbdirectory) = "" Then
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!
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

The above code needs a reference to the Microsoft Scripting Runtime library
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:
Avatar of Chris Raisin
Chris Raisin
Flag of Australia image

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
Thanks everyone, i'll Try these on Monday when I get back to work and see which will work.
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?

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial

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.

the table name is  "Code FileLocation"
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.
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

Link to home
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial
<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"
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!

Trying Craisin's solution. Didn't see it posted before I posted my last comment....
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!