2012年4月19日木曜日

[ACCESS]ACCESSファイル内のレポートのプリンタ指定をテキストファイルで吐き出す

From Evernote:

[ACCESS]ACCESSファイル内のレポートのプリンタ指定をテキストファイルで吐き出す

ACCESSファイル内レポートのプリンタ指定をテキストファイルで吐き出します。
テストしてたら現場のプリンタから出ちゃったとかあるので…。
(97以降対応)


'--------------------------------------------------------------------------------

Function Z_プリンタ調査()

    Dim motoName As String
    motoName = "プリンタ" & Format(Today, "ddhhss")
  
    Dim strMdbName As String
    strMdbName = CurrentDb.Name
  
    SaveModules strMdbName, "", "C:\******.txt"

End Function


Public Sub SaveModules(strMdbName As String, strPw As String, strExpFile As String)
    Dim dbs As DAO.Database
    Dim objAcc As Access.Application
    Dim mdl As Module
    Dim docWork As DAO.Document
    Dim frm As Form
    Dim rpt As Report

    On Error Resume Next

' リストを出力するファイル名
    'Const FILENAME = strExpFile
  
    Open strExpFile For Output As #100
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, "■     MDB Name : " & strMdbName
    Print #100, "■    CreateDay : " & Now
    Print #100, "■"
    Print #100, "■    Copyright (c) 1997-20xx 7key All Rights Reserved."
    Print #100, "■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  

  
    Set dbs = DBEngine.Workspaces(0).OpenDatabase(strMdbName, False, False, ";PWD=" & strPw)
    Set objAcc = GetObject(strMdbName)
  


    Print #100, ""
    Print #100, ""
    Print #100, "■■■  REPORTS   ■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    For Each docWork In dbs.Containers!Reports.Documents
        On Error Resume Next
        objAcc.DoCmd.OpenReport docWork.Name, acDesign
        Set rpt = objAcc.Reports(docWork.Name)
            Print #100, ""
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, "□ Module Name : " & docWork.Name
            Print #100, "□     Created : " & docWork.DateCreated
            Print #100, "□    Modified : " & docWork.LastUpdated
            Print #100, "□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□□"
            Print #100, rpt.Printer.DeviceName
            Print #100, rpt.Printer.DriverName
        objAcc.DoCmd.Close acReport, docWork.Name, acSavePrompt
    Next
  
    Print #100, ""
    Print #100, ""
    Print #100, "■■■  END   ■■■■■■■■■■■■■■■■■■■■■■■■■■■"
    Print #100, ""
    Print #100, ""
  
    Close #100
    dbs.Close
    Set dbs = Nothing

End Sub





0 件のコメント:

コメントを投稿