两个EXCEL文件通信实例

按钮代码

Private Sub 一键输出报表技术_Click()
    '-------------------------------------------------------------------------------------
    '功能说明
    '-------------------------------------------------------------------------------------
    '首先将表格输出到一张表格中,然后将表格中的东西按照一定的方式填写到另外一张表格里去,最后
    '删除复制的表格.
    
    '引用方法:
    '引用方法解释:
    '=====================================================================================
    '参数说明
    '-------------------------------------------------------------------------------------
    'fname              存储数据的EXCEL表格的名字,例如:"表格导出"
    'Folder             报表输出的文件夹,例如:"Excel输出文件夹"
    'ord_path           报表的打开位置,例如:CurrentProject.Path & "\表格导出".xlsx"
    'EXL                EXCEL程序对象,用于存储
    'wkb                用来存储excel 工作簿对象
    'tbl_name           等到导出表格的名字
    '=====================================================================================
    '依赖关系
    '-------------------------------------------------------------------------------------
    'ExportToExcelQueryTables          用来将数据库表格导出的函数
    
    Dim ord_path As String
    Dim fname As String
    Dim Folder As String
    Dim tbl_name As String
    Dim EXL As Object
    Dim wkb As Object
    Dim Errnum As Integer
    Errnum = Err
    
    tbl_name = "销售订单序时簿"
    fname = "表格导出"
    Folder = "Excel输出文件夹"
    ord_path = CurrentProject.Path & "\" & Folder & "\" & fname & ".xlsx"
        
    ExportToExcelQueryTables tbl_name, Folder, fname


    
    If Len(Dir(ord_path, vbDirectory)) > 0 Then
        On Error GoTo 创建:
        'MsgBox "文件" & CurrentProject.Path & "\报表\" & fileName & "已经存在"
        Set EXL = GetObject(, "Excel.Application")
        'Set xlWbk = xlApp.Workbooks.Open(CurrentProject.Path & "\报表\" & wshName)
        Set wkb = EXL.Workbooks.Open(ord_path)
        EXL.Visible = False
        EXL.Visible = True
    Else
        MsgBox "订单不存在,请生成后再打开"
    End If
    
ExitHere:
    '这里关掉一些中间的对象,比方说recordset等
    '但是展现在客户面前的东西不能关闭,
    '最好以显性的方式展现出来
    '这样客户也好关闭
    Exit Sub
    
创建:
    If Err = 429 Then
        Set EXL = CreateObject("Excel.Application")
        Resume Next
    Else
        If (Errnum = Err) Then Exit Sub
        MsgBox "错误编号：" & Err.Number & vbCrLf & "错误描述：" _
        & Err.Description, , "您出错了！"
        Errnum = Err
        Resume ExitHere
    End If
End Sub

依赖函数代码

MODY_导出到EXCEL

Public Function ExportToExcelQueryTables(tbl_name As String, Folder As String, fname As String)
    '-------------------------------------------------------------------------------------
    '功能说明
    '-------------------------------------------------------------------------------------
    '讲数据库的表格放到Folder这个文件夹里的名字是fname的excel表格中
    '引用方法:
    '解释:
    '=====================================================================================
    '参数说明
    '-------------------------------------------------------------------------------------
    '传入参数:
    'tbl_name       数据库表格的名字,也就是等待导出的数据表,例如:生产一部PQ分析表
    'Folder         存储EXCEL工作簿的文件夹名字,例如:"报表"
    'fname          工作簿的名字,例如:"生产一部"
    '函数参数:
    'FilePath       存储EXCEL工作簿的路径
    'xlpath         EXCEL工作簿的路径和名字,例如:FilePath & "\" & fname & ".xlsx"
    '=====================================================================================
    '依赖关系
    '-------------------------------------------------------------------------------------
    '**          ***
    Dim xlpath As String
    Dim FilePath As String
    FilePath = CurrentProject.Path & "\" & Folder
    xlpath = FilePath & "\" & fname & ".xlsx"
    
    
    '------------------<①首先要有"报表这个文件夹">↓------------------
    If Not Len(Dir(FilePath, vbDirectory)) > 0 Then MkDir FilePath '如果位置②没有"报表"这个文件夹,那就创建"报表"文件夹

    If Len(Dir(xlpath, vbDirectory)) > 0 Then
        '*********************判断是否存在同名的文件↓*****************
        If MsgBox("存在同名订单,是否删除?", vbOKCancel + vbInformation, "提示") = vbOK Then
            '退出系统
            Kill xlpath
        Else
            MsgBox "订单未导出!"
            Exit Function
        End If
        '*********************判断是否存在同名的文件↑*****************
    End If
    DoCmd.TransferSpreadsheet acExport, , tbl_name, xlpath, True
    MsgBox "订单已导出"
End Function