TransferSpreadsheet 3125 Error

[Kennelbloke]

Hi Folks. I couldn't find an answer to my specific problem so came to the gurus

I export data from several qureis to the same Excel sheet using
[pre] DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qryTS_Shows", strFileName, True
DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel12Xml, "qryTS_Clubs", strFileName, True[/pre]
etc. There is about 10 all up

When importing back in (appending into a remote location database), I get a "Run-time error 3125". I've found some code (credits to the original author) that looks like it will do the job.
All of my tables are prefixed with "tbl" (tblShows, tblClubs etc) but the sheetnames are the query names. As you can see from the code below I'm stripping the first 6 chars off the front of the sheetname before storing it into the array. I get the error when reading the names from the array. If I leave the sheetnames as original it works fine but it creates new tables with the query names, not what I'm trying to do. I'm obviously missing something, I just can't work out what?

[pre]Private Sub GetExcelFile()
Dim blnHasFieldNames As Boolean, blnEXCEL As Boolean, blnReadOnly As Boolean
Dim lngCount As Long
Dim objExcel As Object, objWorkbook As Object
Dim colWorksheets As Collection
Dim strPassword As String
Dim signfile As Object

Set signfile = Application.FileDialog(3)
signfile.AllowMultiSelect = False

If signfile.Show Then
For i = 1 To signfile.SelectedItems.Count
strFileName = Filename(signfile.SelectedItems(i), sPath)
Next
Else
If IsNull(strFileName) Or strFileName = "" Then
strFileName = "" 'Return a blank to indicate no file selected
MsgBox "Import Cancelled"
Exit Sub
End If
End If
' Establish an EXCEL application object
On Error Resume Next
Set objExcel = GetObject(, "Excel.Application")
If Err.Number <> 0 Then
Set objExcel = CreateObject("Excel.Application")
blnEXCEL = True
End If
Err.Clear
On Error GoTo 0

' Change this next line to True if the first row in EXCEL worksheet
' has field names
blnHasFieldNames = True

' Replace passwordtext with the real password;
' if there is no password, replace it with vbNullString constant
' (e.g., strPassword = vbNullString)
strPassword = vbNullString

blnReadOnly = True ' open EXCEL file in read-only mode

' Open the EXCEL file and read the worksheet names into a collection
Set colWorksheets = New Collection
Set objWorkbook = objExcel.Workbooks.Open(strFileName, , blnReadOnly, , strPassword)
For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add Trim(Right(objWorkbook.Worksheets(lngCount).Name, Len(objWorkbook.Worksheets(lngCount).Name) - 6))
Next lngCount

' Close the EXCEL file without saving the file, and clean up the EXCEL objects
objWorkbook.Close False
Set objWorkbook = Nothing
If blnEXCEL = True Then objExcel.Quit
Set objExcel = Nothing

' Import the data from each worksheet into a separate table
For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tbl" & colWorksheets(lngCount), strFileName, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount

' Delete the collection
Set colWorksheets = Nothing

' Uncomment out the next code step if you want to delete the EXCEL file after it's been imported
' Kill strPathFile
End Sub
[/pre]

 

[combo]

You need to store full worksheet names in collection, to properly address data in workbook to import, otherwise Access tries to import from non-existing sheet.

Build collection:
[pre] For lngCount = 1 To objWorkbook.Worksheets.Count
colWorksheets.Add objWorkbook.Worksheets(lngCount).Name
Next lngCount[/pre]

and next, import:
[pre] For lngCount = colWorksheets.Count To 1 Step -1
DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel12Xml, "tbl" & Trim(Right(colWorksheets(lngCount), Len(colWorksheets(lngCount)) - 6)), strFileName, blnHasFieldNames, colWorksheets(lngCount) & "$"
Next lngCount[/pre]

I don't know what your FileName function does, but it should return full worksheet's path&name, what you already have in [tt]signfile.SelectedItems(i)[/tt].
With signfile.AllowMultiSelect = False you can actually get single item after selecting something or nothing, a loop is not required. Instead, you may need a file type test or add filter to see only Excel files, otherwise the user can select file of any type and Excel will not be able to open it, that results in another error.





combo

 

[Kennelbloke]

Thanks Combo. I'll have a look at this later.

the filename function just returns the full path. I use it a few times so created it as a function.

Public Function Filename(ByVal strPath As String, sPath) As String

sPath = Left(strPath, InStrRev(strPath, "\"))
Filename = strPath

End Function

 

[combo]

Ok, but in this case you get full name from full name. The only benefit is passing path to sPath variable defined outside function.

combo

 

[dhookom]

Have you set any breakpoints in your code to step through line by line to confirm variable values?

Duane
Minnesota
Hook'D on Access
MS Access MVP 2001-2016

 

[Andrzejek]

Your Function [tt]Filename[/tt] returns whatever you pass in [tt]strPath[/tt], so it does not do anything.
It does return full path in [tt]sPath[/tt], but you do not use [tt]sPath[/tt] anywhere in the code provided.

---- Andy

"Hmm...they have the internet on computers now"--Homer Simpson