好吧问答库 > VBS判断文件是否存在，将EXCEL文件1数据插入到EXCE文件2

VBS判断文件是否存在，将EXCEL文件1数据插入到EXCE文件2

以下代码是VBS代码，功能是打开同目录下明为data.xlszz的EXCEL文件。是否有高手能帮忙修改一下打开的时候判断同目录是否有datanew.xlszz的文件如果有则提示，【有更新】如果选择的是【是】1.在同目录下创建1个ord的文件夹，并且把data.xlszz文件复制到ord文件中。2.则把data.xlszz文件将【工作表1 A1----D10的内容，工作表2 D1-----F10的内容】插入到datanew.xlszz文件中的【工作表1 B1----E10，工作表2 E1-----G10】插入成功后提示【数据更新成功】3.点击确定后删除data.xlszz文件，并且把datanew.xlszz文件重命名为data.xlszz文件，提示【更新结束】4.打开data.xlszz文件如果选择的是【否】则直接打开data.xlszz文件。Dim fs, ws,f,fc,aSet fs = CreateObject("Scripting.FileSystemObject")Set ws = CreateObject("WScript.Shell")Path = ws.CurrentDirectorySet f = fs.GetFolder(Path)Set fc = f.FilesSet a = CreateObject("Excel.Application") a.Visible = Truea.Workbooks.Adda.Workbooks.Open f & "尀data.xlszz"

2026年09月22日 13:41

有2个网友回答

网友（1）：

'xlszz扩展名的文件我还真不知道是什么类型的。我这里代码用的是xlsm文件，也就是2007版本以上包含宏的文件类型，如果有需要你自己再改吧。

Private Sub Workbook_Open()

    If ThisWorkbook.Name = "datanew.xlsm" Then Exit Sub '打开new文件时不执行程序

    mypath = ThisWorkbook.Path

    If Dir(mypath & "\datanew.xlsm") <> "" Then   '判断new文件是否存在

        xz = MsgBox("文件有更新，请问是否更新？", vbYesNo, "更新检测")

        If xz = vbYes Then

            If Dir(mypath & "\old", vbDirectory) = "" Then MkDir (mypath & "\old") '判断old目录是否存在，不存在则建立

            Application.DisplayAlerts = False                       '关闭提示框出现

            ThisWorkbook.SaveAs Filename:=mypath & "\old\" & ThisWorkbook.Name & ".old"  '备份到old目录的文件添加了.old扩展，如果不加old，最后打不开同名的文件。

            Application.DisplayAlerts = True                        '打开提示框出现，这里打开是因为一会要弹出“数据更新成功”的提示

            Workbooks.Open (mypath & "\datanew.xlsm")               '打开new文件

            ThisWorkbook.Sheets("sheet1").Range("a1:d10").Copy Workbooks("datanew").Sheets("sheet1").Range("b1")

            ThisWorkbook.Sheets("sheet2").Range("d1:f10").Copy Workbooks("datanew").Sheets("sheet2").Range("e1")        '上两行是两次copy数据

            MsgBox "数据更新成功！", vbOKOnly, "更新提示"

            Workbooks("datanew").Activate

            Application.DisplayAlerts = False               '再次关闭提示框出现

            Workbooks("datanew").SaveAs Filename:=mypath & "\data.xlsm", ConflictResolution:=xlLocalSessionChanges

            Application.DisplayAlerts = True                '再次打开提示框出现

            Kill mypath & "\datanew.xlsm"                   '删除new文件

            MsgBox "更新结束！", vbOKOnly, "更新提示"

            ThisWorkbook.Close False            '到最才关闭，不能中间就关，因为关闭此文件后代码就停止了运行。

        End If

    End If

End Sub

网友（2）：

vba excel各种实现帮解决