EXCELへ出力、汎用モジュール （AccessVBA）

SQLとパスを渡してエクセルへ出力する関数。
オートフィルターもパラメーターにて設定可能。
transferspledsheetが嫌いな人はコピペして使ってください。

Function ex_output(SQL As String, file_name As String, A_fil As Boolean)

'ＳＱＬをエクセルに出力する関数


Dim cn As New ADODB.Connection
Dim ars As New ADODB.Recordset
Dim rs As ADODB.Recordset
Dim xls As Object
Dim wkb As Object
Dim mysheet As Object
Dim IDX As Long

Set cn = CurrentProject.Connection
Set xls = CreateObject("Excel.Application")
Set wkb = xls.Workbooks.Add
Set mysheet = wkb.Worksheets(1)
        
        
'rs.Open SQL, cn, adOpenKeyset, adLockReadOnly
 Set rs = cn.Execute(SQL)
'列見出しを書き出す
For IDX = 1 To rs.Fields.count
     '列名にスペースが入っているものを書き出すためのReplace
    mysheet.cells(1, IDX).Value = Replace(rs.Fields(IDX - 1).Name, ";nbsp;", " ")
    mysheet.cells(1, IDX).Interior.ColorIndex = 20
    
Next

    mysheet.Range("A2").CopyFromRecordset rs

'オートフィルターをつける
If A_fil = True Then
    mysheet.Range("A1").AutoFilter
End If

'列幅を整える
For IDX = 1 To rs.Fields.count
      
    mysheet.Columns(IDX).AutoFit
    
Next

wkb.SaveAs FileName:=file_name, Password:=STRPW

wkb.Close SaveChanges:=False 'Excelへの変更保存をキャンセル

xls.Quit 'Excel終了
xls.DisplayAlerts = True 'メッセージの復旧

'オブジェクトの開放
Set wkb = Nothing
Set xls = Nothing
rs.Close: cn.Close
file_name = ""

'終了通知
'F_MSGBOX ("Export has done!")

ex_output = True

End Function

※当ソースコードは著作権フリーですが、このコードの使用によって生じたいかなる損害に対しても責任を持ちません。