vb读取WPS的EXCEL文档并另存为其他

               

Dim xlAppDim xlApp2Dim xlBookDim xlBook2Dim xlSheetDim xlSheet2Dim getPathDim savePathDim re As RegExpDim msg As StringPrivate Sub Command1_Click()CommonDialog1.FileName = ""CommonDialog1.Flags = cdlOFNFileMustExistCommonDialog1.Filter = "All Files|*.*|(*.xls)|*.xls"CommonDialog1.FilterIndex = 2CommonDialog1.DialogTitle = "打开文件(*.xls)"CommonDialog1.Action = 1getPath = CommonDialog1.FileNameEnd SubPrivate Sub Command2_Click()If getPath <> "" ThenCommonDialog2.FileName = ""CommonDialog2.Filter = "All Files|*.*|(*.xls)|*.xls"CommonDialog2.FilterIndex = 2CommonDialog2.DialogTitle = "另存为(*.xls)"CommonDialog2.Action = 2savePath = CommonDialog2.FileName    If savePath <> "" Then        '打开文件        Set xlApp = CreateObject("Excel.Application")        Set xlApp2 = CreateObject("Excel.Application")        Set xlBook = xlApp.Workbooks.Open(getPath)        Set xlSheet = xlBook.Worksheets(1)        '新建表格        Set xlBook2 = xlApp2.Workbooks.Open(App.Path & "\" & "模板文件.xls")        Set xlSheet2 = xlBook2.Worksheets(1)        '读取并修改文件        xlSheet2.Range("a2") = xlSheet.Range("a2")        xlSheet2.Range("d2") = xlSheet.Range("e2")        xlSheet2.Range("n2") = xlSheet.Range("d2")        xlSheet2.Range("o2") = xlSheet.Range("f2")        xlSheet2.Range("p2") = xlSheet.Range("g2")        xlSheet2.Range("q2") = xlSheet.Range("h2")        xlSheet2.Range("s2") = xlSheet.Range("j2")        xlSheet2.Range("u2") = xlSheet.Range("i2")        xlSheet2.Range("ah2") = "$" & xlSheet.Range("b2")        msg = xlSheet.Range("c2")                '正则表达式解析msg信息        Set re = New RegExp        re.Pattern = "【(\d+)】(.*)\s\(商家编码:(\w+)\)\s\(产品数量:(\d+) piece\)"                If (re.Test(msg) = True) Then            Set re1 = re.Execute(msg)(0)            xlSheet2.Range("ae2") = re1.SubMatches(1)            xlSheet2.Range("ag2") = re1.SubMatches(2)            xlSheet2.Range("aj2") = re1.SubMatches(3)        End If                '保存并关闭文件        xlBook2.SaveAs FileName:=savePath        xlBook.Close        xlApp2.Workbooks(1).Close SaveChanges:=False  '不保存关闭模板文件        xlApp.Quit        xlApp2.Quit        Set xlBook = Nothing        Set xlBook2 = Nothing        Set xlApp = Nothing        Set xlApp2 = Nothing        MsgBox "文件保存成功"    End IfEnd IfEnd Sub