Dim xlApp
Dim xlApp2
Dim xlBook
Dim xlBook2
Dim xlSheet
Dim xlSheet2
Dim getPath
Dim savePath
Dim re As RegExp
Dim msg As String

Private Sub Command1_Click()
CommonDialog1.FileName = ""
CommonDialog1.Flags = cdlOFNFileMustExist
CommonDialog1.Filter = "All Files|*.*|(*.xls)|*.xls"
CommonDialog1.FilterIndex = 2
CommonDialog1.DialogTitle = "打开文件(*.xls)"
CommonDialog1.Action = 1
getPath = CommonDialog1.FileName
End Sub

Private Sub Command2_Click()
If getPath <> "" Then
CommonDialog2.FileName = ""
CommonDialog2.Filter = "All Files|*.*|(*.xls)|*.xls"
CommonDialog2.FilterIndex = 2
CommonDialog2.DialogTitle = "另存为(*.xls)"
CommonDialog2.Action = 2
savePath = 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 If
End If

End Sub