AccessからExcelへの出力
質問します。
AccessからExcelへ、VBAで指定セルに指定データを落としこむコーディングをしています。
とあるサイトを参考に、下記のコードを組みましたが、実行すると砂時計のまま動かなくなってしまいます。
何が悪いのでしょうか?
SQLでしょうか?
時間がなくて困っています。
何卒よろしくお願いします。(><)
Option Compare Database
Private Sub output()
On Error Resume Next
Dim app As Object
Set app = CreateObject("Excel.Application")
Dim oRs As Recordset
Dim strSQL As String
Dim Wb As Excel.Workbook
Dim Ws As Excel.Worksheet
Dim FileName As String
Dim Worksheet As String
Dim X As Long
Dim Y As Long
FileName = "C:\nouhinnsyo.xls" 'エクセルのファイル名
Worksheet = "納品書" 'ワークシート名
Set Wb = app.Workbooks.Open(FileName) 'ワークブックの指定
Set Ws = Wb.Worksheets(1) 'ワークシートの指定
strSQL = "SELECT 日付,伝票番号,品番,商品名,出庫数,摘要"
strSQL = strSQL & vbCrLf & "FROM 棚卸マスタ"
'出力用レコードセット
Set oRs = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)
Y = 12
X = 0
Do Until oRs.EOF
Ws.Cells(Y, X + 1) = oRs("日付")
Ws.Cells(Y, X + 2) = oRs("品番")
Ws.Cells(Y, X + 3) = oRs("商品名")
Ws.Cells(Y, X + 4) = oRs("出庫数")
Ws.Cells(Y, X + 9) = oRs("摘要")
oRs.MoveNext
Y = Y + 1
Loop
oRs.Close
Wb.SaveAs FileName 'ファイルの保存
Wb.Close 'ワークブックのクローズ
Ex.Quit 'エクセルセッションをクローズする。
Set Ws = Nothing '変数の初期化
Set Wb = Nothing '変数の初期化
Set Ex = Nothing '変数の初期化
Set oRs = Nothing
End Sub
お礼