配方 Excel或CSV的匯入匯出
阿新 • • 發佈：2018-11-23
先來看下執行效果：
以下是實現步驟：
第一步：設計介面，參考上面的執行時設計介面即可；
第二步：建立DataFiles檔案，用於存放匯入匯出的Excel或Csv模板來使用的
1、DataFiles資料夾裡主要包含三個檔案 TplPeiFang.csv（需要匯入的CSV模板格式）、TplPeiFang.xlsx（需要匯入的Excel模板格式）、TplPeiFangExport.xlsx（匯出Excel需要被複制的模板）。注意：模板格式必須要按照這種格式
上圖為TplPeiFang.csv 和 TplPeiFang.xlsx的格式
上圖為TplPeiFangExport.xlsx 模板格式
第三步：視窗設計相關的指令碼事件
1、匯入按鈕 左鍵按下 事件
Dim errorDes1,errorDes2,errorTitle Dim fileExtArray,fileName,filePath,fileExt,fileExtIsTrue,fileNameSplitArray fileExtIsTrue=False filePath=Sys.ProjectDir & "\DataFiles\" fileExtArray=Array("csv","xlsx","xls") fileName=Trim(文字框3.Text) errorTitle="系統提示" errorDes1="請輸入檔名" errorDes2="檔案格式只支援：csv,xlsx,xls" errorDes3="檔案模板不存在" '===================================================S_判斷輸入檔案格式是否正確 '判斷檔案不能為空 If Len(fileName)<=0 then MsgBox errorDes1,0,errorTitle Exit Sub End If fileNameSplitArray=Split(fileName,".",-1,1) '判斷檔案格式 為 xxxx.xxx If UBound(fileNameSplitArray)<>1 then MsgBox errorDes2,0,errorTitle Exit Sub End If '判斷檔案格式只支援 csv,xlsx,xls fileExt=LCase(Trim(fileNameSplitArray(1)))'去除左右兩邊空格，並將大寫字母轉換成小寫字母 For i=0 To UBound(fileExtArray) If fileExt=fileExtArray(i) then fileExtIsTrue=True Exit For End If Next If fileExtIsTrue=False then MsgBox errorDes2,0,errorTitle Exit Sub End If '判斷模板檔案是否存在 Set objFSO = CreateObject("Scripting.FileSystemObject") filePath=filePath & fileName If not objFSO.fileExists(filePath) then MsgBox errorDes3,0,errorTitle Exit Sub End If Set objFSO = nothing '===================================================End Dim recipeItemList,recipeItemListCount,peiFangXiangName Dim recipeName,sheetName Dim iDHao,peiFangNeiRong recipeName="Recipe.板件" sheetName="板件" '===================================================S_Excel匯入操作 If fileExt="xlsx" Or fileExt="xls" then Dim xlApp,xlWorkBook,xlSheet Set xlApp = CreateObject("Excel.Application") xlApp.Visible = false Set xlWorkBook = xlApp.Workbooks.Open(filePath) Set xlSheet = xlWorkBook.Sheets(sheetName) '刪除原有的配方項 recipeItemList=RecipeCmd.GetRecipeItemList(recipeName) recipeItemListCount=recipeItemList.Count If recipeItemListCount>0 then For i=0 To recipeItemListCount-1 recipeItemName=recipeItemList(i) Call RecipeCmd.RemoveRecipeItem(RecipeName,recipeItemName) Next End If '讀取Excel，配方項最多限制1000個 For i=2 To 1000 peiFangXiangName = xlApp.WorkSheets(SheetName).Cells(i,1).Value iDHao = xlApp.WorkSheets(sheetName).Cells(i,2).Value peiFangNeiRong = xlApp.WorkSheets(sheetName).Cells(i,3).Value If Len(peiFangXiangName)<=0 then Exit For End If '迴圈將資料表的內容匯入到配方項 Call RecipeCmd.AddRecipeItem(recipeName,peiFangXiangName,"配方項："&peiFangXiangName) '建立配方項 '匯入配方成份值 Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"ID號",IDHao) Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"配方內容",peiFangNeiRong) 配方瀏覽器0.SaveRecipe() Next xlWorkBook.Save xlWorkBook.Close xlApp.Quit set xlSheet = Nothing set xlWorkBook = Nothing set xlApp = Nothing End If '===================================================End '===================================================S_CSV匯入操作 If fileExt="csv" then '刪除原有的配方項 recipeItemList=RecipeCmd.GetRecipeItemList(recipeName) recipeItemListCount=recipeItemList.Count If recipeItemListCount>0 then For i=0 To recipeItemListCount-1 recipeItemName=recipeItemList(i) Call RecipeCmd.RemoveRecipeItem(RecipeName,recipeItemName) Next End If Const ForReading = 1 Dim csvFSO, csvFile, strline,lineCount lineCount=0 Set csvFSO = nothing Set csvFSO = CreateObject("Scripting.FileSystemObject") Set csvFile = csvFSO.OpenTextFile(filePath, ForReading) Do While csvFile.AtEndOfStream<>True If lineCount>0 then strline=csvFile.readline strlineArray=Split(strline,",",-1,1) If UBound(strlineArray)>0 then peiFangXiangName = strlineArray(0) iDHao = strlineArray(1) peiFangNeiRong = strlineArray(2) '迴圈將資料表的內容匯入到配方項 Call RecipeCmd.AddRecipeItem(recipeName,peiFangXiangName,"配方項："&peiFangXiangName) '建立配方項 '匯入配方成份值 Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"ID號",IDHao) Call RecipeCmd.SetRecipeItemValue(recipeName,peiFangXiangName,"配方內容",peiFangNeiRong) 配方瀏覽器0.SaveRecipe() End If End If lineCount=lineCount+1 Loop csvFile.close Set csvFSO = nothing End If '===================================================End MsgBox "匯入成功"
2、匯出按鈕 左鍵按下 事件
Dim sltType Const ForWriting = 8 Dim objFSO, objFile, strline,strWrite,sheetName Dim RecipeName Set objFSO = CreateObject("Scripting.FileSystemObject") RecipeName="Recipe.板件" sheetName="板件" sltType=組合框0.SelectedIndex '===================================================S_匯出CSV If sltType=0 then newFileName= "配方"&Sys.Year&Sys.Month&Sys.Day&"_"&Sys.Hour&Sys.Minute&Sys.Second&Sys.Millisecond filePath=Sys.ProjectDir & "\DataFiles\"&newFileName&".csv" '判斷檔案是否存在，不存在則建立檔案 If not objFSO.fileExists(filePath) then Call objFSO.CreateTextFile(filePath,True) End If '寫入csv文字內容 Set objFile = objFSO.OpenTextFile(filePath, ForWriting,false) '獲取配方項的值 recipeItemList= RecipeCmd.GetRecipeItemList(RecipeName) recipeItemListCount=recipeItemList.Count strRecipeItem="配方項," '獲取配方成分 recipeElList= RecipeCmd.GetRecipeElementList(RecipeName) recipeElListCount=recipeElList.count '組裝首行 For j=0 To recipeElListCount-1 recipeElValue=recipeElList(j) strRecipeItem=strRecipeItem&recipeElValue&"," Next strRecipeItem=Left(strRecipeItem,Len(strRecipeItem)-1) objFile.WriteLine(strRecipeItem) '組裝資料行 For i=0 To recipeItemListCount-1 dataROW="" chengfenRow="" peifangxiangName=recipeItemList(i) dataROW=dataROW&peifangxiangName&"," For k=0 To recipeElListCount-1 chengfenValue=RecipeCmd.GetRecipeItemValue(RecipeName,peifangxiangName,recipeElList(k)) chengfenRow=chengfenRow&chengfenValue&"," Next dataROW=dataROW&chengfenRow dataROW=Left(dataROW,Len(dataROW)-1) objFile.WriteLine(dataROW) Next objFile.close Set fso = nothing End If '===================================================End '===================================================S_匯出Excel If sltType=1 then filePath=Sys.ProjectDir & "\DataFiles\TplPeiFangExport.xlsx" '如果檔案不存在建立檔案 If not objFSO.fileExists(filePath) then MsgBox "模板檔案不存在" Exit Sub End If newFileName= "配方"&Sys.Year&Sys.Month&Sys.Day&"_"&Sys.Hour&Sys.Minute&Sys.Second&Sys.Millisecond newFilePath=Sys.ProjectDir & "\DataFiles\"&newFileName&".xlsx" objFSO.CopyFile filePath,newFilePath,False Set objFSO = nothing '寫入Excel dim xlApp,xlWorkBook,xlSheet dim iRowCount,iLoop,numAdd set xlApp = CreateObject("Excel.Application") xlApp.Visible = false set xlWorkBook = xlApp.Workbooks.Open(newFilePath) set xlSheet = xlWorkBook.Sheets(sheetName) '讀取配方_項資料 recipeItemList=RecipeCmd.GetRecipeItemList(RecipeName) recipeItemListCount=recipeItemList.Count '讀取配方_成分 recipeElementList=RecipeCmd.GetRecipeElementList(RecipeName) recipeElementListCount=recipeElementList.Count '迴圈寫入配方項 If CInt(recipeItemListCount)>0 then For i=0 To recipeItemListCount-1 '配方項 recipeItemValue=recipeItemList(i) xlApp.cells(i+2,1)=recipeItemValue Next End If '配方成份值 If CInt(recipeItemListCount)>0 then For k=0 To recipeItemListCount-1 recipeItemValue=recipeItemList(k)'配方項 If CInt(recipeElementListCount)>0 then For l=0 To recipeElementListCount-1 recipeElmentName=recipeElementList(l) recipeElementValue=RecipeCmd.GetRecipeItemValue(RecipeName,recipeItemValue,recipeElmentName) xlApp.cells(k+2,l+2)=recipeElementValue Next End If Next End If xlWorkBook.Save xlWorkBook.Close xlApp.Quit set xlSheet = Nothing set xlWorkBook = Nothing set xlApp = Nothing End If '===================================================End MsgBox "匯出成功"
3、查詢按鈕 左鍵按下事件
recipNmae="Recipe.板件"
recipItemName=""
inpputValue=文字框0.Text
recipeItemList=RecipeCmd.GetRecipeItemList(recipNmae)
For i=0 To recipeItemList.Count-1
recipeItemVlue=recipeItemList(i)
'MsgBox recipeItemVlue
'比對值
valueStr=RecipeCmd.GetRecipeItemValue(recipNmae,recipNmae&"."&recipeItemVlue,recipNmae&".ID號")
If (CStr(inpputValue) = CStr(valueStr)) then
recipItemName=recipeItemVlue
End If
Next
Call RecipeCmd.LoadRecipeItem(recipNmae,recipItemName)查詢按鈕 左鍵擡起事件
文字框0.Text=""
文字框0.Focus()
文字框0.SelectAll()第四步：變數相關建立
第五步：視窗設計相關的屬性和關聯變數
1、組合框
2、ID號文字框
3、配方內容 文字框
