| |
▼にしもり さん：
こんにちは。Accessの方はお久しぶりですね。
[#4844]にて
>「TransferSpreadsheet」のヘルプには「acExport」の際のRange指定は
>記載されていないので正しい使い方ではないと思いますが、
>当方の環境では作動しております。（WindowsXP/Access2002/Excel2002）
と書きましたが、やはり正しい使い方でないのか弊害がでてしまいました。
Excel の CopyFromRecordset というメソッドを使用してコードを書き直しました。
Sub TEST2()
Dim FSO As Object
Dim xlsApp As New Excel.Application
Dim xlsWkb As Excel.Workbook
Dim xlsSht As Excel.Worksheet
Dim MyFile As Variant
Dim Cnt As Long
'
'TBLのデータをレコードセットに記録
'-----------------------------------------------------------
'DAOの場合
Dim RS As DAO.Recordset
Set RS = CurrentDb.OpenRecordset("aa")
'ADOの場合
'Dim RS As New ADODB.Recordset
'RS.Open "SELECT * FROM aa", CurrentProject.Connection
'-----------------------------------------------------------
'出力ファイルの指定
MyFile = "C:\新しいフォルダ\回数表.xls"
MyFile = "C:\Documents and Settings\x0007546.MOS\デスクトップ\サンプル\aaa.xls"
'存在チェック
Set FSO = CreateObject("Scripting.FileSystemObject")
If Not (FSO.FileExists(MyFile)) Then
DoCmd.TransferSpreadsheet acExport, _
acSpreadsheetTypeExcel9, "aa", MyFile, True
Else
'出力先ファイルにシートを追加
Set xlsWkb = xlsApp.Workbooks.Open(MyFile)
Cnt = xlsWkb.Sheets.Count
xlsWkb.Sheets.Add after:=xlsApp.Worksheets(Cnt)
Set xlsSht = xlsWkb.ActiveSheet
xlsSht.name = "aa" & Cnt
For Cnt = 1 To RS.Fields.Count
xlsSht.Cells(1, Cnt).Value = RS.Fields(Cnt - 1).name
Next
xlsSht.Range("A2").CopyFromRecordset RS
xlsWkb.Close True: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
End If
RS.Close
Set RS = Nothing
End Sub
参照設定を開いて、
>> Microsoft DAO x.x Object Library
にチェックがついていればDAOで、
>> Microsoft ActiveX Data Objects x.x Library
にチェックがついていればADOで、
両方ともチェックがあればお好きな方で試してみてください。
|
|
小僧
- 05/5/13(金) 13:47 -
