因為一些工作的因素,必須撰寫程式將使用者繕打在EXCEL中的文件內文,轉換成XML並儲存起來,內容沒啥營養,只是使用VBA寫東西有如回到25年前在寫ASP(Basic)的痛苦與生疏感,筆記在此供給有需要的人參考。
其實文章的重點就是把表格資料儲存成文字檔案,XML只是一種表述的格式而已。
Step 1. 建立一個名為「會員資料表」的EXCEL頁籤,內容如下:
Step 2. 產生一個名為「產生XML檔」的EXCEL頁籤,並在上面利用「開發人員」功能項次>「插入」>「表單控制項」>「按鈕」,插入一個按鈕作為讓使用者操作的進入點(新增巨集:按鈕1_Click),並針對這個按鈕進行文字與外觀等設計工作。
Step 3. 對這棵按鈕點擊進入VBA編輯畫面(Microsoft Visual Basic for Applications),在Module1裡面會出現「按鈕1_Click()」的Sub副程式進入點,接著就在這邊插入我們想要編寫的程式碼。
Step 4. 將下列的VBA(Visual Basic Applications)程式碼貼上:
Sub 按鈕1_Click() '***** 定義資料表 ***** Dim cSheetName As String Dim oWS As Worksheet cSheetName = "會員資料表" Set oWS = Worksheets(cSheetName) '***** 求取資料與欄位數量資訊 ***** Dim iRows As Long Dim iColumns As Long '資料數 If oWS.UsedRange Is Nothing Then iRows = 0 Else iRows = oWS.UsedRange.Rows.Count End If '欄位數 If oWS.UsedRange Is Nothing Then iColumns = 0 Else iColumns = oWS.UsedRange.Columns.Count End If '***** 檢查資料填入區間是否符合期望 ***** Dim cMessage As String If iColumns <> 4 Then cMessage = "總欄位數目應該為4欄,請查閱資料表的欄位是否有不應該出現的資料。" End If If Len(Trim(oWS.Cells(iRows, 1))) = 0 Then cMessage = "系統偵測最後一筆資料之行號為「" & iRows & "」,但該筆資料的第一個欄位內容卻沒有賦值。" End If If Len(cMessage) > 0 Then Response = MsgBox(cMessage, vbCritical, "嚴重錯誤") Exit Sub End If '***** 收集資料進入陣列 ***** Dim cTemp As String Dim dTemp As String ReDim aryData(1 To iRows, 1 To iColumns) For I = 2 To iRows For J = 1 To iColumns cTemp = Trim(Replace(oWS.Cells(I, J).Value, vbLf, "")) '檢查賦值是否正確 Select Case J Case 1 If Len(cTemp) <> 5 Then cMessage = "「會員編號」必須為5碼" Else aryData(I, J) = cTemp End If Case 2 If Len(cTemp) = 0 Then cMessage = "「姓名」不可為空值" Else aryData(I, J) = cTemp End If Case 3 If Not IsDate(cTemp) Then cMessage = "「生日」必須為日期格式" Else aryData(I, J) = cTemp End If Case 4 If Not IsNumeric(cTemp) Then cMessage = "「存款」必須為數值格式" Else aryData(I, J) = cTemp End If Case Else aryData(I, J) = cTemp End Select '若有錯誤則組裝行列資訊 If Len(cMessage) > 0 Then cMessage = "行號「" & I & "」資料之" & cMessage Response = MsgBox(cMessage, vbCritical, "嚴重錯誤") Exit Sub End If Next J Next I '***** 處理資料 ***** Dim cXML As String 'Header cXML = "<?xml version=""1.0"" ?>" & vbCrLf & _ "<data>" & vbCrLf 'Body For I = 2 To iRows cXML = cXML & _ " <member seq=""" & (I - 1) & """>" & vbCrLf & _ " <id>" + aryData(I, 1) + "</id>" & vbCrLf & _ " <name>" + aryData(I, 2) + "</name>" & vbCrLf & _ " <birthday>" + aryData(I, 3) + "</birthday>" & vbCrLf & _ " <money>" + aryData(I, 4) + "</money>" & vbCrLf & _ " </member>" & vbCrLf Next I 'Footer cXML = cXML & _ "</data>" '***** 寫入檔案 ***** Dim cPath As String Dim cFileName As String cPath = Environ("USERPROFILE") & "\Desktop\" cFileName = Format(Now(), "yyyyMMddHHmmss") & "_會員資料.xml" '寫入資料 Set oFS = CreateObject("Scripting.FileSystemObject") Set oFile = oFS.CreateTextFile(cPath & cFileName, True, True) oFile.Write cXML oFile.Close '顯示成功訊息 Response = MsgBox("已經將「" & cFileName & "」檔案產生到您的桌面", vbInformation, "產生XML檔案成功") 'Debug.Print cXML End Sub
Step 5. 完成後將這個EXCEL儲存可以執行的*.xlsm格式,當使用者編輯會員資料表後,再去點擊按鈕,VBA就會將資料以XML格式產生後,將文字檔儲存在使用者的桌面上。