Solved

Visual Basic Error 52 Bad File Name

Posted on 2011-02-11
22
961 Views
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"
Else
    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
        rst.MoveNext
        nbrROW = nbrROW + 1
    Loop
End With

objWKB.Save
objWKB.Close
appEXCEL.Quit

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
    .Display
    .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.Close

DoCmd.OpenForm ("frm_OrderLog")

Exit Sub

err_email:
    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

DoCmd.Maximize

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

0
Comment
Question by:nellafurtado
  • 8
  • 4
  • 4
  • +3
22 Comments
 

Author Comment

by:nellafurtado
Comment Utility
Not sure if this helps but it is MS Access front end and SQL Server backend.

Thanks!
0
 
LVL 8

Expert Comment

by:Toxacon
Comment Utility
\ is a path separator not a path itself. What is the value of strPTH after row 173?
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
change this

If Dir (strPTH) = "\" Then


with

If Dir (strPTH,vbdirectory) = "" Then
0
 

Author Comment

by:nellafurtado
Comment Utility
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!
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
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)

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

Open in new window

0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
The above code needs a reference to the Microsoft Scripting Runtime library
0
 
LVL 45

Expert Comment

by:aikimark
Comment Utility
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:
http://www.experts-exchange.com/A_2253.html
0
 
LVL 13

Assisted Solution

by:Chris Raisin
Chris Raisin earned 334 total points
Comment Utility
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.

Syntax
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.
0
 

Author Comment

by:nellafurtado
Comment Utility
Thanks everyone, i'll Try these on Monday when I get back to work and see which will work.
0
 

Author Comment

by:nellafurtado
Comment Utility
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?

Thanks!
0
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 
LVL 119

Assisted Solution

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


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

Author Comment

by:nellafurtado
Comment Utility
Capricorn,

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.

Thanks!
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
the table name is  "Code FileLocation"
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
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.
0
 
LVL 31

Expert Comment

by:Helen_Feddema
Comment Utility
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, _
      CursorType:=adOpenForwardOnly
      
   '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
   rst.Close

Open in new window

0
 
LVL 13

Accepted Solution

by:
Chris Raisin earned 334 total points
Comment Utility
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\MyFile.xxx"
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.
0
 
LVL 119

Expert Comment

by:Rey Obrero
Comment Utility
<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>

correction

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

Author Comment

by:nellafurtado
Comment Utility
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!

Thanks!
0
 

Author Comment

by:nellafurtado
Comment Utility
Trying Craisin's solution. Didn't see it posted before I posted my last comment....
0
 

Author Closing Comment

by:nellafurtado
Comment Utility
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!

Thanks!
0

Featured Post

Maximize Your Threat Intelligence Reporting

Reporting is one of the most important and least talked about aspects of a world-class threat intelligence program. Here’s how to do it right.

Join & Write a Comment

Suggested Solutions

Everyone has problem when going to load data into Data warehouse (EDW). They all need to confirm that data quality is good but they don't no how to proceed. Microsoft has provided new task within SSIS 2008 called "Data Profiler Task". It solve th…
A simple tool to export all objects of two Access files as text and compare it with Meld, a free diff tool.
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 …
In Microsoft Access, learn how to “cascade” or have the displayed data of one combo control depend upon what’s entered in another. Base the dependent combo on a query for its row source: Add a reference to the first combo on the form as criteria i…

744 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

15 Experts available now in Live!

Get 1:1 Help Now