running into a snag .... I need to import *.xlsm and *.xls files .. I have
the following code in my userform. How do I change it so that it lists more
than just 1 type of file?

FName=Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")

Also, I get the following error after selecting a *.xlsm file:

Run-time error '-2147467259 (80004005)':
External table is not in the expected format.

This is the code I am using:

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' BEGIN CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
Private Sub btnBrowse_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
If FName = False Then
Exit Sub
End If
Me.tbxWorkbook.Text = FName
ListSheets CStr(FName)
End Sub

Private Sub ListSheets(WBName As String)
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim TableName As String

Set CN = New ADODB.Connection
With CN
..ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=""Excel 8.0;"""
..Open
Set RS = .OpenSchema(adSchemaTables)
End With

Me.lbxSheets.Clear
Do While Not RS.EOF
TableName = RS.Fields("table_name").Value
If Right$(TableName, 1) = "$" Then
Me.lbxSheets.AddItem Left(TableName, Len(TableName) - 1)
End If
RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub

Private Sub btnCopySheet_Click()
Dim WB As Workbook
Dim WS As Worksheet

If Me.lbxSheets.Value = vbNullString Then
Exit Sub
End If
Application.ScreenUpdating = False
Set WB = Application.Workbooks.Open(Me.tbxWorkbook.Text)
Set WS = WB.Worksheets(Me.lbxSheets.Value)
With ThisWorkbook.Worksheets
WS.Copy after:=.Item(.Count)
ActiveSheet.Name = "Import"
End With
WB.Close savechanges:=False
Application.ScreenUpdating = True
Unload Me
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' END CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

What am I doing wrong? Any help would greatly be appreciated.

Jeff

If you just want excel files:
FName = Application.GetOpenFilename("Excel Files,*.xls*")

If you wanted to be explicit, maybe...
FName = Application.GetOpenFilename("Excel Files, *.xls;*.xlsm;*.xlsx")

I don't speak ADO.

You may want to share what file type you're trying to open, the version of excel
and whether this happens with any of those file types or just one workbook.

It may help someone help you.

JeffJ wrote:

running into a snag .... I need to import *.xlsm and *.xls files .. I have
the following code in my userform. How do I change it so that it lists more
than just 1 type of file?

FName=Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")

Also, I get the following error after selecting a *.xlsm file:

Run-time error '-2147467259 (80004005)':
External table is not in the expected format.

This is the code I am using:

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' BEGIN CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
Private Sub btnBrowse_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
If FName = False Then
Exit Sub
End If
Me.tbxWorkbook.Text = FName
ListSheets CStr(FName)
End Sub

Private Sub ListSheets(WBName As String)
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim TableName As String

Set CN = New ADODB.Connection
With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(adSchemaTables)
End With

Me.lbxSheets.Clear
Do While Not RS.EOF
TableName = RS.Fields("table_name").Value
If Right$(TableName, 1) = "$" Then
Me.lbxSheets.AddItem Left(TableName, Len(TableName) - 1)
End If
RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub

Private Sub btnCopySheet_Click()
Dim WB As Workbook
Dim WS As Worksheet

If Me.lbxSheets.Value = vbNullString Then
Exit Sub
End If
Application.ScreenUpdating = False
Set WB = Application.Workbooks.Open(Me.tbxWorkbook.Text)
Set WS = WB.Worksheets(Me.lbxSheets.Value)
With ThisWorkbook.Worksheets
WS.Copy after:=.Item(.Count)
ActiveSheet.Name = "Import"
End With
WB.Close savechanges:=False
Application.ScreenUpdating = True
Unload Me
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' END CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

What am I doing wrong? Any help would greatly be appreciated.

Jeff

--

Dave Peterson

For the OP

For 2007 use Microsoft.ACE.OLEDB.12.0

See the code on this page that choose the correct one
http://www.rondebruin.nl/ado.htm



--

Regards Ron de Bruin
http://www.rondebruin.nl/tips.htm




"Dave Peterson" wrote in message ...
If you just want excel files:
FName = Application.GetOpenFilename("Excel Files,*.xls*")

If you wanted to be explicit, maybe...
FName = Application.GetOpenFilename("Excel Files, *.xls;*.xlsm;*.xlsx")

I don't speak ADO.

You may want to share what file type you're trying to open, the version of excel
and whether this happens with any of those file types or just one workbook.

It may help someone help you.

JeffJ wrote:

running into a snag .... I need to import *.xlsm and *.xls files .. I have
the following code in my userform. How do I change it so that it lists more
than just 1 type of file?

FName=Application.GetOpenFilename("Excel Files (*.xlsm),*.xlsm")

Also, I get the following error after selecting a *.xlsm file:

Run-time error '-2147467259 (80004005)':
External table is not in the expected format.

This is the code I am using:

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' BEGIN CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''
Private Sub btnBrowse_Click()
Dim FName As Variant
FName = Application.GetOpenFilename("Excel Files (*.xls),*.xls")
If FName = False Then
Exit Sub
End If
Me.tbxWorkbook.Text = FName
ListSheets CStr(FName)
End Sub

Private Sub ListSheets(WBName As String)
Dim CN As ADODB.Connection
Dim RS As ADODB.Recordset
Dim TableName As String

Set CN = New ADODB.Connection
With CN
.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & WBName & ";" & _
"Extended Properties=""Excel 8.0;"""
.Open
Set RS = .OpenSchema(adSchemaTables)
End With

Me.lbxSheets.Clear
Do While Not RS.EOF
TableName = RS.Fields("table_name").Value
If Right$(TableName, 1) = "$" Then
Me.lbxSheets.AddItem Left(TableName, Len(TableName) - 1)
End If
RS.MoveNext
Loop
RS.Close
CN.Close
End Sub

Private Sub btnClose_Click()
Unload Me
End Sub

Private Sub btnCopySheet_Click()
Dim WB As Workbook
Dim WS As Worksheet

If Me.lbxSheets.Value = vbNullString Then
Exit Sub
End If
Application.ScreenUpdating = False
Set WB = Application.Workbooks.Open(Me.tbxWorkbook.Text)
Set WS = WB.Worksheets(Me.lbxSheets.Value)
With ThisWorkbook.Worksheets
WS.Copy after:=.Item(.Count)
ActiveSheet.Name = "Import"
End With
WB.Close savechanges:=False
Application.ScreenUpdating = True
Unload Me
End Sub

'''''''''''''''''''''''''''''''''''''''''''''''''' ''
' END CODE
'''''''''''''''''''''''''''''''''''''''''''''''''' ''

What am I doing wrong? Any help would greatly be appreciated.

Jeff

--

Dave Peterson