| |
▼clike さん：
お待たせ致しました。ご指摘の通り、一行なんか空白がありますね…。
まぁ DoCmd.TransferSpreadsheet を正しく使っていない結果でしょうか。
以下のように修正しました。コードがややこしくなってしまい申し訳ないです。
※要Excel,DAO参照設定
Sub xlsOut()
Dim FSO As Object
Dim RS As DAO.Recordset
Dim xlsApp As New Excel.Application
Dim xlsWkb As New Excel.Workbook
Dim xlsSht As New Excel.Worksheet
Dim MyTBL As String
Dim MyFile As Variant
Dim MyDate As String
Dim MySheet As Variant
Dim Cnt As Long
'出力するテーブル、出力先ファイルの指定
MyDate = Format(Now(), "m月dd日")
MyTBL = "tempTBL"
MyFile = "c:\temp.xls"
'存在チェック
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not (FSO.FileExists(MyFile)) Then
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, MyTBL, MyFile, True
'エクセルシートの名前を変更
Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
xlsWkb.Sheets(MyTBL).Name = MyDate
xlsWkb.Save
xlsWkb.Close: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
Else
'同日のシートが見つかった場合は削除
Set RS = CurrentDb.OpenRecordset(MyTBL, dbOpenDynaset)
Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
For Each MySheet In xlsWkb.Sheets
If MySheet.Name = MyDate Then
xlsApp.DisplayAlerts = False
xlsWkb.Sheets(MyDate).Delete
xlsApp.DisplayAlerts = True
Exit For
End If
Next
'出力先ファイルにシートを追加
Cnt = xlsWkb.Sheets.Count
xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
Set xlsSht = xlsWkb.ActiveSheet
xlsSht.Name = MyDate
For Cnt = 1 To RS.Fields.Count
xlsSht.Cells(1, Cnt).Value = RS.Fields(Cnt - 1).Name
Next
xlsSht.Range("A2").CopyFromRecordset RS
xlsWkb.Save
xlsWkb.Close: Set xlsSht = Nothing: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
RS.Close
Set RS = Nothing
End If
End Sub
>またテーブルではなく、クエリの場合は、利用かのでしょうか？
よくこういったご質問をお見かけしますが、
「まずやってみる！」のはいかがでしょうか？
（テストができない環境でしたら申し訳ありません。）
やってみて不具合がでる、うまくいくけど何か不安、etc… でしたら
再度投稿して頂ければ出来る限り（私でなくてもどなたかがきっと）
お答えしますので、提示されたコードをコピーするだけでなく、
がんばってオリジナルにも挑戦して頂きたいなと思います。
ちなみにこのコードですと変数：MyTBL にクエリの名前を入れて頂ければ
Excelに出力可能です。
|
|
小僧
- 05/4/15(金) 14:09 -
