xlFile = "......" '浏览到文件;
If FSO.FileExists(xlFile) Then
'******************************************************************************************************** If UCase(Right(xlFile, 4)) = "XLSX" Then
sConnectionString = "Driver={Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)};DBQ=" & xlFile & ";"
ElseIf (UCase(Right(xlFile, 4)) = ".XLS") Then
sConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xlFile & ";Extended Properties=""Excel 8.0;HDR=Yes;"";"
ElseIf (UCase(Right(xlFile, 4)) = ".MDB") Then
sConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & xlFile
ElseIf (UCase(Right(xlFile, 4)) = "CCDB") Then
sConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & xlFile
'********************************************************************************************************
End If
Else
MsgBox "请选择数据文件"
End If
Dim cn As adodb.Connection
Set cn = New adodb.Connection
With cn
.ConnectionString = sConnectionString
.Open
End With
Dim strCol As String
Dim rsC As adodb.Recordset
Set rsC = cn.OpenSchema(adSchemaColumns, Array(Empty, Empty, strTbl, Empty))
Dim lOrdinalOrder As Long
Dim ar() As Variant
Dim L As Long
L = 0
If Not rsC.EOF And Not rsC.BOF Then
rsC.MoveFirst
Do While Not rsC.EOF
L = L + 1
rsC.MoveNext
Loop
ReDim ar(L)
rsC.MoveFirst
Do While Not rsC.EOF
strCol = rsC.Fields("COLUMN_NAME").Value
lOrdinalOrder = rsC.Fields("ORDINAL_POSITION").Value
ar(lOrdinalOrder) = strCol
rsC.MoveNext
Loop