1

以下は、MS Access 2010 マクロから呼び出されます。マクロ RUN コマンドを使用してルーチンを実行すると、データのファイルが正しく作成され、"c:\EOW" フォルダーに保存されます。フォームのボタンからマクロを実行すると、マクロ RUN とまったく同じように動作して終了するように見えますが、マクロ RUN メソッドの場合のようにファイル出力はありません。アドバイスをいただければ幸いです。

スコット

マクロの呼び出しは "ExportQueryToTxt("MYOBWklyInvoices","c:\EOW\MYOBWklyInvoices.txt",1,",")" で、VBA 関数は以下のとおりです。

Option Compare Database
Option Explicit

Public Function ExportQueryToTxt(ByVal DataSource As String, _
                     ByVal FileName As String, _
                     Optional DocIDIndex As Long = 0, _
                     Optional ByVal ListSeparator As String = ",")

' See  http://www.dbforums.com/microsoft-access/1664379-automatically-adding-blank-lines-text-file.html
'
' SMW NOTE: definitely does not work with a query with a PARAMETER in it
'           Does work if make a table from query and use it
' DataSource:    Name of a table, a SELECT query or a SELECT SQL statement.
'                In any case, the rowset must be sorted on the DocIDIndex column.

' FileName:      Name of the output file that will receive the exported rows.

' DocIDIndex:    Ordinal position of the column in the rowset
'                that contains the document ID (default = 0 --> first column).

' ListSeparator: Character used to separate the different columns of data
'                in the text output file (default = ",")
'
' Example of call: ExportQueryToTxt "Qry_Export", "c:\export.txt", 1, ";"
'
    Dim dbs As DAO.Database
    Dim rst As DAO.Recordset
    Dim fld As DAO.Field
    Dim intHandle As Integer
    Dim strLine As String
    Dim varDocID As Variant

    intHandle = FreeFile
    Open FileName For Output As #intHandle   ' Use 'For Append' to add lines to an existing file, if any.
    Set dbs = CurrentDb
    ' MsgBox ("Started")
    Set rst = dbs.OpenRecordset(DataSource)

    ' SMW load first line with MYOB field names + input week number parameter
    strLine = ""
    strLine = "Ignore,Invoice,Customer PO,Description,Account,Amount,Inc Tax,Supplier,Journal Memo,SP First Name,Tax Code,GST Amount,Category,CardID"
    Print #intHandle, strLine
    strLine = ""
    ' End SMW
    With rst
        If Not .EOF Then
        ' note that following will group anything wth same invoice or similar number togeher in
        ' sequential rows then inject a blank row when the invoice number changes
        varDocID = rst.Fields(DocIDIndex).Value
            Do Until .EOF
                For Each fld In rst.Fields
                    If Len(strLine) > 0 Then strLine = strLine & ListSeparator
                    strLine = strLine & fld.Value
                Next
                If rst.Fields(DocIDIndex).Value <> varDocID Then strLine = vbNewLine & strLine
                Print #intHandle, strLine
                strLine = ""
                varDocID = rst.Fields(DocIDIndex).Value
                .MoveNext
            Loop
        End If
        .Close
    End With
    Set rst = Nothing
    Close #intHandle
    ' SMW added to advise when done
    ' MsgBox ("Finished making invoices")

End Function
4

1 に答える 1