配方 Excel或CSV的导入导出

版权声明：如有雷同请告知我，我会第一时间下架。如有转载请标明出处。 https://blog.csdn.net/qq_40191093/article/details/82499247

先来看下运行效果：

以下是实现步骤：

第一步：设计界面，参考上面的运行时设计界面即可；

第二步：创建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、配方内容 文本框