Run-time error -2147467259 (80004005) in SQL string for connection

[James Snyder]

I am getting run-time error -12147467259 on the sheet name used in the connection query. I have used a query to open a connection before and am puzzled as to why it doesn't work now.

Declarations and the call:

Public Sub Main()
    
    Dim fileName As String                  ' Reuseable parameter
    Dim obstInFile As String                ' Source spreadsheet for Obstructed
    Dim obstConn As ADODB.Connection        ' ADO connection for obstructed
    Dim obstRS As ADODB.Recordset           ' ADO recordset for obstructed
    Dim obsSQL As String                    ' String to pass to set up the recordset

<snip>

    obsSQL = "SELECT * FROM [Obstructed$] GROUP BY [Item No.] ORDER BY [PSID]"
    funcReturn = MakeConnection(obstConn, obstRS, obsSQL, obstInFile)
    If funcReturn <> "Success" Then
        errString = "Obstructed Excel: Unable to create obstructed recordset"
        failReturn = ProblemReport(errString, sendDate)
        GoTo ExitPoint
    End If

The function:

Private Function MakeConnection(ByRef newConn As ADODB.Connection, _
    ByRef newRS As ADODB.Recordset, _
    ByRef sqlStr As String, _
    ByRef sourceWkSht As String) As String
    
    ' Declarations
    Dim connStr As String
        
    ' ADO ACCESS TO SPREADSHEET
    ' Create the ADO objects to be used
    Set newConn = New ADODB.Connection
    Set newRS = New ADODB.Recordset
    
    ' Open the connection
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sourceWkSht _
        & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=1';"
    newConn.Open connStr
    
    ' Open the spreadsheet
    With newRS
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .Open sqlStr, newConn
    End With
    Set newConn.ActiveConnection = Nothing  ' Sets recordset to disconnected recordset
    
    MakeConnection = "Failed to create recordset"
End Function

The error gets generated on the [Obstructed$] sheet name when .Open sqlStr, newConn is called.

 

[Zack Barresse]

Hi there,

It's hard to tell, since you haven't posted all of your code. The range you pass should be something like this "[Sheet1$A1:B100]". I only see a sheet name.

 

[James Snyder]

Thanks for the reply. I am pulling in the entire sheet, so the range is the sheet. I can paste more code, but none is pertinent to the connection or recordset. What do you not see that is needed?

 

[James Snyder]

Entire code is as follows:
Main in it's entirety:

Option Explicit ' Must declare variables - clean programming technique
Public nextFP As Integer        ' Exceptions file
Public nextFP1 As Integer       ' Output Obstructed xlsx
Public nextFP2 As Integer       ' Output FTP xlsx
Public nextFP3 As Integer       ' Output FTP text file
Public testFlag As Boolean      ' Run the reports, but do not FTP or email
'

Public Sub Main()
    
    ' Declarations and Definitions
    Dim fileName As String                  ' Reuseable parameter
    Dim obstInFile As String                ' Source spreadsheet for Obstructed
    Dim obstConn As ADODB.Connection        ' ADO connection for obstructed
    Dim obstRS As ADODB.Recordset           ' ADO recordset for obstructed
    Dim obsSQL As String                    ' String to pass to set up the recordset
    Dim workOInFile As String               ' Source spreadsheet for work orders
    Dim workOConn As ADODB.Connection       ' ADO connection for work orders
    Dim workORS As ADODB.Recordset          ' ADO recordset for work orders
    Dim workOSQL As String                  ' String to pass to set up the recordset
    Dim ftpInFile As String                 ' Source spreadsheet for FTP
    Dim ftpConn As ADODB.Connection         ' ADO connection for FTP
    Dim ftpRS As ADODB.Recordset            ' ADO recordset for FTP
    Dim ftpSQL As String                    ' String to pass to set up the recordset
    Dim exceptFile As String                ' Exceptions file for records not sent
    Dim obstOutFile As String               ' Obstructed/Moved/Not On Premises file
    Dim ftpOutFile As String                ' Output spreadsheet for reconciliation
    Dim ftpTextFile As String               ' Output text file for FTP to client
    Dim funcReturn As String                ' Returns error message for function failures
    Dim failReturn As String                ' Returns path of Exceptions file or ""
    Dim errString As String                 ' Reuseable parameter string for error messages
    Static sendDate As String               ' File date used for all created files
    Dim cellRef As Range                    ' Reuseable parameter for sheet data
    
    ' Get the Obstructed file path
    fileName = "Obstructed.xlsx"
    Set cellRef = Range("$I$2")
    obstInFile = RetrieveFilePath(cellRef, fileName, sendDate)
    If obstInFile = "" Then
        errString = "Obstructed.xlsx:  Unable to find file path."
        failReturn = ProblemReport(errString, sendDate)
        GoTo ExitPoint
    End If
    
    ' Get the WorkOrder file path
    fileName = "WorkOrders.xlsx"
    Set cellRef = Range("$I$3")
    workOInFile = RetrieveFilePath(cellRef, fileName, sendDate)
    If workOInFile = "" Then
        errString = "WorkOrder.xlsx:   Unable to find file path."
        failReturn = ProblemReport(errString, sendDate)
        GoTo ExitPoint
    End If
    
    ' Get the FTP file path
    fileName = "FTP.xlsx"
    Set cellRef = Range("$I$4")
    ftpInFile = RetrieveFilePath(cellRef, fileName, sendDate)
    If ftpInFile = "" Then
        errString = "FTP.xlsx:         Unable to find file path."
        failReturn = ProblemReport(errString, sendDate)
        GoTo ExitPoint
    End If
    
    ' Open the Obstructed recordset
    obsSQL = "SELECT * FROM [Obstructed$] GROUP BY [Item No.] ORDER BY [PSID]"
    funcReturn = MakeConnection(obstConn, obstRS, obsSQL, obstInFile)
    If funcReturn <> "Success" Then
        errString = "Obstructed Excel: Unable to create obstructed recordset"
        failReturn = ProblemReport(errString, sendDate)
        GoTo ExitPoint
    End If
    
    ' Open the WorkOrder recordset
'    obsSQL = "SELECT * FROM [WorkOrders$] GROUP BY [Item No.] ORDER BY [PSID]"
'    funcReturn = MakeConnection(workOConn, workORS, workOSQL, workOInFile)
'    If funcReturn <> "Success" Then
'        errString = "WorkOrders Excel: Unable to create obstructed recordset"
'        failReturn = ProblemReport(errString, sendDate)
'        GoTo ExitPoint
'    End If
    
    ' Open the FTP recordset
'    obsSQL = "SELECT * FROM [FTP$] GROUP BY [Item No.] ORDER BY [PSID]"
'    funcReturn = MakeConnection(ftpConn, ftpRS, ftpSQL, ftpInFile)
'    If funcReturn <> "Success" Then
'        errString = "FTP Excel:        Unable to create obstructed recordset"
'        failReturn = ProblemReport(errString, sendDate)
'        GoTo ExitPoint
'    End If
    
ExitPoint:
    FinalCleanup obstConn, _
        obstRS, _
        workOConn, _
        workORS, _
        ftpConn, _
        ftpRS, _
        exceptFile, _
        obstOutFile, _
        ftpOutFile, _
        ftpTextFile
End Sub

The MakeConnection function in it's entirety:

Private Function MakeConnection(ByRef newConn As ADODB.Connection, _
    ByRef newRS As ADODB.Recordset, _
    ByRef sqlStr As String, _
    ByRef sourceWkSht As String) As String
    
    ' Declarations
    Dim connStr As String
        
    ' ADO ACCESS TO SPREADSHEET
    ' Create the ADO objects to be used
    Set newConn = New ADODB.Connection
    Set newRS = New ADODB.Recordset
    
    ' Open the connection
    connStr = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & sourceWkSht _
        & ";Extended Properties='Excel 12.0;HDR=YES;IMEX=1';"
    newConn.Open connStr
    
    ' Open the spreadsheet
    With newRS
        .CursorLocation = adUseClient
        .CursorType = adOpenForwardOnly
        .Open sqlStr, newConn
    End With
    Set newConn.ActiveConnection = Nothing  ' Sets recordset to disconnected recordset
    
    MakeConnection = "Failed to create recordset"
End Function

The RetrieveFilePath function:

Private Function RetrieveFilePath(cellRef As Range, _
    inFile As String, _
    ByRef sendDate As String) As String
    
    Dim pickedPath As String
    Dim truncPath As String
    Dim file1Dialog As FileDialog
    Dim pathLen As Integer
    Dim hashLocat As Integer
    Dim file1Picked As Long
    Dim returnValue As Long
    
    If Not cellRef Is Nothing Then
        If FileExists(CStr(cellRef.Value) & "\" & inFile) Then
            RetrieveFilePath = CStr(cellRef.Value) & "\" & inFile
        Else
            Set file1Dialog = Application.FileDialog(msoFileDialogFilePicker)
            With file1Dialog
                .InitialFileName = "C:\Work\Daily FTP Process\BFout\"
                .Title = "Select the source folder for Bluefolder report " & inFile
                .AllowMultiSelect = False
                file1Picked = file1Dialog.Show
                
                ' Button chosen check
                If file1Picked <> -1 Then
                    returnValue = MsgBox(inFile & " path not selected. Program closing...", _
                    vbOKOnly, _
                    "Path not selected.")
                    RetrieveFilePath = ""
                    Exit Function       ' Bypass final return assignment
                Else
                    pickedPath = .SelectedItems(1)
                    hashLocat = InStrRev(pickedPath, "\")
                    truncPath = Left(pickedPath, hashLocat - 1)
                    Range(cellRef.Address).Value = truncPath    ' Store path only
                End If
            End With
        
            RetrieveFilePath = pickedPath
            Set file1Dialog = Nothing
        End If
    End If
End Function

The ProblemReport function:

Public Static Function ProblemReport(probLine As String, _
    ByRef sendDate As String) As String

    ' This procedure is static, keeping state in memory until the process is closed.
    ' It will take one line passed in and write it to the same file
    Dim probFile As String
    Dim testFile As String
    Dim curPath As String
    Dim testPath As String
    Dim probPath As String
    Dim probFolder As String
    
    ' Check for existance of a subfolder for the report to be placed in
    curPath = Application.ThisWorkbook.Path & Application.PathSeparator
        
    ' Add the new directory we want to use
    probPath = curPath & "Exceptions" & Application.PathSeparator
    If Len(Dir(probPath, vbDirectory)) = 0 Then
        MkDir (probPath)
    End If
    
    ' Pull in the file date if created
    If Not sendDate <> "" Then
        sendDate = FileDate(sendDate)
    End If
    
    ' Build the full path and file name
    probFile = probPath & "Exceptions-" & sendDate & ".log"
    
    ' Test for the existance of the file before attempting to recreate it
    testPath = Left(probFile, Len(probPath & "Exceptions" & sendDate) - 2)
    testFile = testPath & "*.log"
    If FileExists(testFile) = False Then
        ' Create the text log
        nextFP = FreeFile()     ' Get the next free file number
        Open probFile For Output As #nextFP  ' Open for write
    End If
    
    ' Add our exception line
    Print #nextFP, probLine
    
    ' Return our exception file path for closure at the end
    ProblemReport = probFile
End Function

The FileDate function:

Private Function FileDate(inDate As String) As String
    ' Declarations and Definitions
    Dim today As Date
    Dim yestDate As String
    Dim yestHour As String
    Dim yestMinute As String
    Dim yestSecond As String
    Dim dateLen As Integer
    
    If inDate = "" Then         ' If it doesn't already exist, make it
        dateLen = 14
        today = Now()
        yestDate = Format(WorksheetFunction.WorkDay_Intl(today, -1, 1), _
            "yyyymmddHhNnSs")
        yestDate = Left(yestDate, 8)
        yestHour = CStr(Hour(today))
        yestMinute = CStr(Minute(today))
        yestSecond = CStr(Second(today))
        yestDate = yestDate & yestHour & yestMinute & yestSecond
        If Len(yestDate) <> dateLen Then
            yestDate = yestDate & "0"
        End If
        
        FileDate = yestDate     ' Return the static date for yesterday
    Else
        FileDate = inDate       ' Return a useable date regardless
    End If
End Function

The FileEists function:

Private Function FileExists(pathStr As String) As Boolean
    ' Tests a passed path for existance and returns true/false
    If Dir(pathStr, vbDirectory) = "" Then
        FileExists = False
    Else
        FileExists = True
    End If
End Function

The CloseObj function:

Private Sub CloseObj(ByRef obj As Variant)
    If Not obj Is Nothing Then
        obj.Close
        Set obj = Nothing
    End If
End Sub

The FinalCleanup function:

Private Sub FinalCleanup(ByRef obstConn As ADODB.Connection, _
    ByRef obstRS As ADODB.Recordset, _
    ByRef workOConn As ADODB.Connection, _
    ByRef workORS As ADODB.Recordset, _
    ByRef ftpConn As ADODB.Connection, _
    ByRef ftpRS As ADODB.Recordset, _
    ByRef exceptFile As String, _
    ByRef outObsFile As String, _
    ByRef outftpInFile As String, _
    ByRef outTxtFile As String)
    
    Dim boolFlag As Boolean
    
    CloseObj obstRS
    CloseObj obstConn
    CloseObj workORS
    CloseObj workOConn
    CloseObj ftpRS
    CloseObj ftpConn
    
    If Not exceptFile = "" Then
        Close #nextFP       ' Close our error log if created
        nextFP = 0
    End If
    
    If Not outObsFile = "" Then
        Close #nextFP1      ' Close our new Obstructed spreadsheet if created
        nextFP1 = 0
    End If
    
    If Not outftpInFile = "" Then
        Close #nextFP2      ' Close our new FTP spreadsheet if created
        nextFP2 = 0
    End If
    
    If Not outTxtFile = "" Then
        Close #nextFP3      ' Close our new text file
        nextFP3 = 0
    End If
End Sub

I think that is all that is hooked in so far. The file pointers will get moved and passed as parameters eventually. The testFlag variable will be used once output is written to suppress FTPing and Emailing to customers.

 

[RoryA]

Have you double-checked the sheet name is correct in the file (no leading or trailing spaces for example). Is there any error text besides the number?

 

[James Snyder]

I have changed the name of the incoming report several times causing the sheet to be renamed. I have then copied and pasted the sheet name (using rename) into the macro. I think I have exhaustively tested that.

There was error text to the effect of [Obstructed$] not defined or similar. I will try to post later with the exact phrasing.

 

[James Snyder]

I'll try to get a screen shot on here:
03.07.2013-09.34.14 - Bermex's library

 

[RoryA]

I can't see anything inherently wrong with the code offhand. How is the source file generated initially?

 

[James Snyder]

The source file is generated from an application called Bluefolder. It exports a run report to a spreadsheet and names the sheet after the name of the Bluefolder report that exported it. It is exported in .xls format. A previous automation demo had a successful SQL string of "SELECT * FROM [(D) COMPLETED INSPECTION - COMM$]" that I pulled each column's information from and built a proof of concept text output file in fixed format for database entry at the client's site.

 

[RoryA]

If it's xls format why are you specifying Excel 12.0 in the connection string?
Does it help if you open the file in Excel and save and close it first?