asked on

TransferSpreadsheet Error: Unexpected error from external database driver (1309).

I have a subroutine in Excel that calls a subroutine in Access. The subroutine in Access calls the TransferSpreadsheet function which transfers an Access table to the Excel file that called the Access procedure. The code breaks at the TransferSpreadsheet function.

Here's the error I'm getting

Run-time error '3275':

Unexpected error from external database driver (1309).

MS Office Help says error 1309 indicates:
The specified external database driver returned an error. This error can be caused by performing an operation not supported on this type of external database.

MSDN says error 1309 indicates:
1309 Can't modify table structure. Another user has the table open.

I think I know what the problem is. In the Excel workbook a dialog box is open. It says that "MS Office Excel is waiting for another application to complete and OLE action. So Excel is locked up while it's waiting for the Access procedure to finish but the Access procedure can't finish until it is able to make changes to the Excel file.

Is there a simple/smart workaround for this? (Hopefully one that doesn't involve opening a an empty Excel file, transferring to that file, and then copying from that file to the Excel file I want the data in.)

Thank you for you help!

ASKER CERTIFIED SOLUTION

Patrick Matthews

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ltdanp22

ASKER

Thanks Patrick. I'll look into using the recordset and CopyFromRecordset. Meanwhile, code is below...

'DP 2010-03-03: 1 OP File
'Export POSummary to Access database
Sub ImportOutputTemplate()

    Dim sFilePathDatabase As String
    Dim sFilePathIOOutput As String
    Dim sWorksheetName As String
    Dim sDateTimeStamp As String
    Dim sProgramGroup As String
    Dim sSelectedChannel As String
    
    Dim lProgramIndex As Long
    Dim lProgramGroupIndex As Long
    
    Dim wkbDest As Workbook

    Dim dbs As Access.Application
    
    'Path to IO Output file
    sDateTimeStamp = Mid(ThisWorkbook.Name, 11, 19)
    sProgramGroup = Mid(ThisWorkbook.Name, 31, 5)
    lProgramGroupIndex = CLng(sProgramGroup)
    sFilePathIOOutput = "C:\ChannelModel\BatchRun\" & sDateTimeStamp & "\IO Output " & sDateTimeStamp & " " & sProgramGroup & ".xlsm"

    'Set wkbDest = Workbooks.Open(sFilePathIOOutput)
    Set dbs = CreateObject("Access.Application")

    'If Not wkbDest Is Nothing Then
    lProgramIndex = ThisWorkbook.Worksheets("Program Ops Summary").Range("K1")
'        sWorksheetName = "PO Program Level - Program" & lProgramIndex
'        wkbDest.Worksheets.Add(Before:=Worksheets("PO Item Level")).Name = sWorksheetName
'        Set wksDest = wkbDest.Worksheets(sWorksheetName)
'        With ThisWorkbook.Worksheets("Program Ops Summary")
'            .Calculate
'            .Range("A1:AC31").Copy
'        End With
'        wksDest.Range("A1:AC31").PasteSpecial Paste:=xlPasteValues
'        wksDest.Range("A1:AC31").PasteSpecial Paste:=xlPasteFormats
'        wksDest.Range("W:AB").EntireColumn.Hidden = True
'        wksDest.Range("AD:AD").EntireColumn.Hidden = True
'        wksDest.Range("AH:AI").EntireColumn.Hidden = True
'        wkbDest.Close True 'Must close IO Output before TransferSpreadsheet
'        Set wkbDest = Nothing
'    Else
'        MsgBox "Cannot find " & sFilePathIO, vbOKOnly
'    End If
    
    If ThisWorkbook.Worksheets("Program Ops Summary").Range("N1").Value = "Current" Then 'M/b better to display MsgBox
        sSelectedChannel = ThisWorkbook.Worksheets("Detail Output").Range("F51").Value
    Else
        sSelectedChannel = ThisWorkbook.Worksheets("Program Ops Summary").Range("N1").Value
    End If
    
    sFilePathDatabase = "C:\ChannelModel\BatchRun\" & sDateTimeStamp & "\ISCM Output " & sDateTimeStamp & ".accdb"
    dbs.OpenCurrentDatabase sFilePathDatabase

    dbs.Run "ExportSelectedChannel", lProgramGroupIndex, lProgramIndex, sSelectedChannel
    dbs.Quit
    
    Set dbs = Nothing
    
End Sub

Public Sub ExportSelectedChannel(lProgramGroupIndex As Long, lProgramIndex As Long, sSelectedChannel As String)

    Dim dbs As Database
    Dim qdf As QueryDef
    Dim sDateTimeStamp As String
    Dim sFolderPath As String
    Dim sFileName As String
    Dim sSQL As String
    Dim sAND As String
        
    'Dim lCounter As Long
    Dim xlApplication As Excel.Application
    'Dim wkbIPOSummary As Excel.Workbook
    
    Dim vWhereClause As Variant
    Dim sChanType As String
    Dim sFreightPayment As String
    Dim sFlow As String
    
    Set dbs = CurrentDb
    
    sAND = " AND "
    
    'Get DateTimeStamp from this ISCM Output file
    sDateTimeStamp = Mid(Dir(CurrentDb.Name), 13, 19)
    sFolderPath = "C:\ChannelModel\BatchRun\" & sDateTimeStamp & "\"
    
    'Build query
    If sSelectedChannel = "Optimal" Then
    
        sSQL = dbs.QueryDefs("qryIPOSummaryOptimalChannel").SQL

    Else

        sSQL = dbs.QueryDefs("qryIPOSummarySelectedChannel").SQL
       
        If InStr(sSelectedChannel, "RDC") Then
            sChanType = "RDC"
        ElseIf InStr(sSelectedChannel, "Trap") Then
            sChanType = "Trap"
        ElseIf InStr(sSelectedChannel, "Transload") Then
            sChanType = "Transload"
        ElseIf InStr(sSelectedChannel, "Store") Then
            sChanType = "Store"
        End If
        
        If InStr(sSelectedChannel, "Collect") Then
            sFreightPayment = "Collect"
        ElseIf InStr(sSelectedChannel, "Prepaid") Then
            sFreightPayment = "Prepaid"
        End If
        
        If InStr(sSelectedChannel, "1XD") Then
            sFlow = "1XD"
        ElseIf InStr(sSelectedChannel, "Stock") Then
            sFlow = "Stock"
        End If
        
        If sChanType <> "" Then
            vWhereClause = (vWhereClause + sAND) & "tblFinalOutput.ChannelText = " & "'" & sChanType & "'"
        End If
        
        If sFreightPayment <> "" Then
            vWhereClause = (vWhereClause + sAND) & "tblFinalOutput.FreightPaymentText = " & "'" & sFreightPayment & "'"
        End If
        
        If sFlow <> "" Then
            vWhereClause = (vWhereClause + sAND) & "tblFinalOutput.FlowText = " & "'" & sFlow & "'"
        End If
        
    End If
    
    Set xlApplication = New Excel.Application
    
    'Remove ";" from SQL statement
    If InStr(sSQL, ";") Then
        sSQL = Left(sSQL, InStr(sSQL, ";") - 1)
    End If
    
    Set qdf = dbs.CreateQueryDef("qryIOOutput", sSQL & " AND tblFinalOutput.ProgramGroupIndex = " & lProgramGroupIndex & " AND tblFinalOutput.ProgramIndex = " & lProgramIndex & " " & vWhereClause & ";")
    sFileName = "IO Output " & sDateTimeStamp & " " & Format(lProgramGroupIndex, "00000") & ".xls"
    DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, "qryIOOutput", sFolderPath & sFileName, True
    xlApplication.Workbooks.Open sFolderPath & sFileName
    xlApplication.Run ("CopyItemLevelSummary")
    xlApplication.Workbooks(sFileName).Save
    DoCmd.DeleteObject acQuery, "qryIOOutput"
    
    Set qdf = Nothing
    Set dbs = Nothing

End Sub

Open in new window