以下は、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