使用VB實現Excel自動獲取外部數據

Excel表格生成和公式設置十分強大便利，是一個強有力的信息分析與處理工具。Visual Basic是一套可視化、面向對象、事件驅動方式的結構化高級程序設計語言，正成為高效率的Windows應用程序開發工具。由于微軟的努力，Visual Basic應用程序版可作為一種通用宏語言被所有微軟可編程應用軟件共享。

Excel面始之初帶有表格處理類軟件中功能最強的宏語言，通過單擊“工具”菜單中的“宏”，選擇宏名來調用宏過程。隨后發展至Visual Basic for Application專用版，可制作按鈕、復選框、單選鈕等控件，賦控件以宏名，單擊控件運行宏，事件驅動方式就Click（單擊）一種。新近推出的Office97套件中的Excel97,在“工具”菜單中選擇“宏”后，就會發現增加了“Visual Basic編輯器”功能。運用這個新增功能，就完全與Visual Basic編程無異了。在菜單欄上單擊鼠標右鍵，選擇彈出式菜單中的“控件工具箱”，在“控件工具箱”工具條上，單擊待添加的控件按鈕，在工作表中將控件拖曳到所需位置和大小，單擊鼠標右鍵選中“屬性”設置控件屬性后，雙擊控件就會出現Visual Basic編輯器。選擇該控件的一個事件如Click或Change,編寫程序。在工作表中操作該控件，如鼠標單擊、鍵入字符等，則觸發相應事件，執行相應程序。


                          圖1

筆者在Excel97平臺，采用Visual Basic應用程序版開發了一套“通用報表分析系統”(界面如圖1)。該系統用于擁有眾多子公司的母公司的每月財務報表合并匯總。所有子公司的統計報表如資產負債表、損益表是由FoxBase編制的財務軟件生成的dbf文件，取名為ATV001xx.dbf----xx月份資產負債表，ATV002xx.dbf----xx月份損益表等。一個子公司的所有dbf文件放在一個單獨的目錄中，如C:\T\palm1，C:\T\palm2等。母公司每月份生成的匯總報表為TTTyymm.xls(yy----年份，mm----月份)，它有“資產負債表”、“損益表”等若干工作表組成。每張工作表是由所有子公司相應的dbf文件的相應項目的數據相加而成。只要將dbf文件逐一轉化到TTTyymm.xls中去，很容易利用Excel的公式設置功能生成母公司的每張匯總報表。
這套系統的關鍵在于如何將所有dbf文件轉換到同一個Excel工作簿中。直接通過“文件”菜單中的“打開”項, 選擇文件類型為dBase文件（*.dbf）, 可將dbf文件轉換到Excel工作簿中,但這工作簿只存轉換而來的一張工作表，其他表都自動關閉了。另外,通過“工具”菜單中的“向導”，選擇“文件轉換”后， 只是將一系列dbf文件轉換為一系列xls文件而已。于是采用建立ODBC數據源獲取外部數據的辦法, 將dbf文件逐一轉換到一個Excel工作簿內, 且用Visual Basic for Application將轉換過程自動化。只要按一下圖1中的“生成報表”按鈕, 就能完成所有dbf 文件的轉換, 且利用Excel公式自動計算功能完成所有報表的匯總計算。按“顯示報表”按鈕，選擇表名，可以瀏覽報表數據。
具體的方法是：

一、 建立ODBC數據源
(1) 打開“數據”菜單, 選擇“獲取外部數據”, 然后單擊“新建查詢”;
(2) 在“選擇數據源”對話框中, 雙擊“<新數據源>”;
(3) 出現“創建新數據源”對話框,輸入數據源名稱, 選擇驅動程序如Microsoft dBase Driver(*.dbf), 單擊“連接”;
(4) 在“ODBC dBase安裝”對話框中, 單擊“使用當前工作目錄”前的復選框, 去掉缺省( , 單擊“選定目錄(s)”, 選擇子公司存放dbf文件的目錄如C:\T\palm1, 連按“確定”；
(5) 當出現Microsoft Quary對話框時, 單擊“關閉”, 退出。不要理會出現的警示信息，因為此時只需建立數據源, 并不需要用Microsoft Query查詢數據;
(6) 重復上述步驟, 在(4)中改換另一家子公司的目錄, 就為另一家子公司建立一個數據源。必須建立所有子公司的數據源。

二、手動獲取外部數據
(1) 單擊“數據”，選取“獲取外部數據”，單擊“新建查詢”；
(2) 出現“選取數據源”對話框，點中“使用查詢向導創建/ 編輯查詢”前的復選框，然后雙擊數據源名，如palm1;
(3) 在“查詢向導——選擇列”對話框中選擇一個查詢表名，單擊 > 鍵，“查詢中用到的列”框內會出現表中所有列名，單擊“下一步”；
(4) 出現“查詢向導——過濾數據”，單擊“下一步”；
(5) 出現“查詢向導——排序順序”，單擊“下一步”；
(6) 出現“查詢向導——完成”，點中“將數據返回Microsoft Excel”前的單選鈕，單擊“完成”；
(7) 出現“將外部數據返回到Excel”對話框，選中“新建工作表”，按“確定”；
(8) 在建立查詢的工作簿內新建工作表，并放入轉換好的數據。這樣就將一個 dbf 文件轉換好了。
(9)重復上述過程，所有子公司的dbf文件轉換到同一個工作簿中。

三、 使用VB實現Excel自動獲取外部數據
(1) 進行手動獲取外部數據(1)步驟前，單擊“工具”菜單中的“宏”，選擇“錄制新宏”，在“宏名”的編輯框中鍵入宏名dbftoxls,按“確定”鍵；
(2) 完成手動獲取外部數據(1)-(8)步驟；
(3) 單擊“工具”菜單中的“宏”，選擇“停止錄制”。這樣就將獲取外部數據的過程記錄為宏。
(4) 編輯dbftoxls宏，加以修改，使它作為Visual Basic模塊表中的一個子程序，并設置調用參數。
提供的程序如下：

`設置初值
Const apppath = "c:\my documents\palmxls\"
Const modulefile = apppath + "module.xls"
Const staticspre = "TTT"
Const dbfpre = "ATV00"

`調用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("資產負債表").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 

原文轉自：http://www.anti-gravitydesign.com