二、手動獲取外部數(shù)據(jù)
(1) 單擊“數(shù)據(jù)”，選取“獲取外部數(shù)據(jù)”，單擊“新建查詢”；
(2) 出現(xiàn)“選取數(shù)據(jù)源”對話框，點中“使用查詢向?qū)?chuàng)建/ 編輯查詢”前的復選框，然后雙擊數(shù)據(jù)源名，如palm1;
(3) 在“查詢向?qū)Аx擇列”對話框中選擇一個查詢表名，單擊 > 鍵，“查詢中用到的列”框內(nèi)會出現(xiàn)表中所有列名，單擊“下一步”；
(4) 出現(xiàn)“查詢向?qū)А^濾數(shù)據(jù)”，單擊“下一步”；
(5) 出現(xiàn)“查詢向?qū)А判蝽樞颉?，單擊“下一步”?div style="height:15px;">
(6) 出現(xiàn)“查詢向?qū)А瓿伞?，點中“將數(shù)據(jù)返回
Microsoft Excel”前的單選鈕，單擊“完成”；
(7) 出現(xiàn)“將外部數(shù)據(jù)返回到Excel”對話框，選中“新建工作表”，按“確定”；
(8) 在建立查詢的工作簿內(nèi)新建工作表，并放入轉(zhuǎn)換好的數(shù)據(jù)。這樣就將一個 dbf 文件轉(zhuǎn)換好了。
(9)重復上述過程，所有子公司的dbf文件轉(zhuǎn)換到同一個工作簿中。
三、 使用VB實現(xiàn)Excel自動獲取外部數(shù)據(jù)
(1) 進行手動獲取外部數(shù)據(jù)(1)步驟前，單擊“工具”菜單中的“宏”，選擇“錄制新宏”，在“宏名”的編輯框中鍵入宏名dbftoxls,按“確定”鍵；
(2) 完成手動獲取外部數(shù)據(jù)(1)-(8)步驟；
(3) 單擊“工具”菜單中的“宏”，選擇“停止錄制”。這樣就將獲取外部數(shù)據(jù)的過程記錄為宏。
(4) 編輯dbftoxls宏，加以修改，使它作為Visual Basic模塊表中的一個子程序，并設(shè)置調(diào)用參數(shù)。
提供的程序如下：
`設(shè)置初值
Const apppath = "c:\my documents\palmxls\"
Const modulefile = apppath + "module.xls"
Const staticspre = "TTT"
Const dbfpre = "ATV00"
`調(diào)用dbftoxls的模塊
Private Sub Cmdgeneratetable_Click()
Dim staticsfile As String
Dim s1 As String
Dim s2 As String
Dim s3 As String
Dim idyes As Integer
Dim dbfstring As String
On Error GoTo errhandler1
idyes = 6
s1 = txtyear.Text
s1 = Mid(s1, 3, 2)
s2 = txtmonth.Text
If Len(s2) = 1 Then
s2 = "0" + s2
End If
staticsfile = apppath + staticspre + s1 + s2 + ".xls"
If FileLen(staticsfile) > 0 Then
choice = MsgBox("該年月報表已存在，是否重新生成？", vbYesNo + vbExclamation + vbDefaultButton1, "")
If choice = idyes Then
Workbooks.Open FileName:=staticsfile
For i = 0 To companynum - 1
For j = 0 To tablenum - 1
dbfstring = dbfpre + Trim(Str$(j + 1)) + s2
sqlstring = sqlstringfunc(dbfstring, fieldlist(),
tablefieldnum(j))
Call dbftoxls(s(i, j), sqlstring)
Next j
Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End If
Exit Sub
errhandler1:
Select Case Err
Case 53
Workbooks.Open FileName:=modulefile
s3 = s1 + "年" + s2 + "月"
Sheets("資產(chǎn)負債表").Range("e4").FormulaR1C1 = "'" + s3
ActiveWorkbook.SaveAs FileName:=staticsfile, FileFormat _
:=xlNormal, Password:="", WriteResPassword:="",
ReadOnlyRecommended:= _
False, CreateBackup:=False
For i = 0 To companynum - 1
For j = 0 To tablenum - 1
dbfstring = dbfpre + Trim(Str$(j + 1)) + s2
sqlstring = sqlstringfunc(dbfstring, fieldlist(),
tablefieldnum(j))
Call dbftoxls(s(i, j), sqlstring)
Next j
Next i
ActiveWorkbook.Save
ActiveWorkbook.Close
End Select
End Sub
`dbftoxls子程序
Sub dbftoxls(activesheetname, sqlstring)
Sheets(activesheetname).Activate
Cells.Select
Selection.Clear
Range("a1").Select
With ActiveSheet.QueryTables.Add(Connection:=Array(Array( _
"ODBC;CollatingSequence=ASCII;DBQ=C:\T\palm1;DefaultDir=
C:\T\palm1;Deleted=1;
Driver={Microsoft dBase Driver (*.dbf)};
DriverId=533;FIL"), Array( "=dBase III;
ImplicitCommitSync=Yes;
MaxBufferSize=512;
MaxScanRows= 8;
PageTimeout=600;
SafeTransactions=0;
Statistics=0;
Threads=3;Use" ), Array("rCommitSync=Yes;")),
Destination:=Range("A1"))
.Sql = Array( sqlstring)
.FieldNames = True
.RefreshStyle = xlInsertDeleteCells
.RowNumbers = False
.FillAdjacentFormulas = False
.RefreshOnFileOpen = False
.HasAutoFormat = True
.BackgroundQuery = True
.TablesOnlyFromHTML = True
.Refresh BackgroundQuery:=False
.SavePassword = True
.SaveData = True
End With
End Sub
