troubleshooting Question

Access VBA SQL - Endless Looop

Avatar of shieldsco
shieldscoFlag for United States of America asked on
Microsoft AccessVBASQL
8 Comments3 Solutions108 ViewsLast Modified:
I'm using the code below and it's in a never ending loop. Thoughts

Public Function Import_System_Access_Reports()

Dim strFolder As String
Dim db As DAO.Database
Dim qdf As DAO.QueryDef
Dim strFile As String
Dim strTable As String
Dim strExtension As String
Dim lngFileType As Long
Dim strSQL As String
Dim strFullFileName As String
Dim varPieces As Variant

 With Application.FileDialog(4) ' msoFileDialogFolderPicker
     If .Show Then
         strFolder = .SelectedItems(1)
     Else
         MsgBox "No folder specified!", vbCritical
         Exit Function
     End If
 End With
 If Right(strFolder, 1) <> "\" Then
     strFolder = strFolder & "\"
 End If
 strFile = Dir(strFolder & "*.xls*")
 Do While strFile <> ""

     lngPos = InStrRev(strFile, ".")
    strTable = "RawData" '<- this could be a constant instead of a variable
Set db = CurrentDb()
' make the UPDATE a parameter query ...
strSQL = "UPDATE [" & strTable & "] SET FileName=[pFileName]" & vbCrLf & _
    "WHERE FileName Is Null OR FileName='';"
Set qdf = db.CreateQueryDef(vbNullString, strSQL)

strFile = Dir(strFolder & "*.xls*")
Do While Len(strFile) > 0
    varPieces = Split(strFile, ".")
    strExtension = varPieces(UBound(varPieces))
    Select Case strExtension
    Case "xls"
        lngFileType = acSpreadsheetTypeExcel9
    Case "xlsx", "xlsm"
        lngFileType = acSpreadsheetTypeExcel12Xml
    Case "xlsb"
        lngFileType = acSpreadsheetTypeExcel12
    End Select
    strFullFileName = strFolder & strFile
    DoCmd.TransferSpreadsheet _
            TransferType:=acImport, _
            SpreadsheetType:=lngFileType, _
            TableName:=strTable, _
            Filename:=strFullFileName, _
            HasFieldNames:=True ' or False if no headers

    ' supply the parameter value for the UPDATE and execute it ...
    qdf.Parameters("pFileName").Value = strFile
    qdf.Execute dbFailOnError
Loop
    'Move to the next file
    strFile = Dir
Loop
     'Clean up
     Set fld = Nothing
     Set tdf = Nothing
     Set db = Nothing
     'rstTable.Close
     Set rstTable = Nothing

End Function
ASKER CERTIFIED SOLUTION
Join our community to see this answer!
Unlock 3 Answers and 8 Comments.
Start Free Trial
Learn from the best

Network and collaborate with thousands of CTOs, CISOs, and IT Pros rooting for you and your success.

Andrew Hancock - VMware vExpert
See if this solution works for you by signing up for a 7 day free trial.
Unlock 3 Answers and 8 Comments.
Try for 7 days

”The time we save is the biggest benefit of E-E to our team. What could take multiple guys 2 hours or more each to find is accessed in around 15 minutes on Experts Exchange.

-Mike Kapnisakis, Warner Bros