Access VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃過去ログ ┃ホーム

6407 / 9994

←次へ　｜　前へ→


	【6791】Re:レコード数を制御して、Excelへ吐き出し

Saiyama - 05/11/10(木) 22:26 -


	引用なし

	パスワード

小僧さん
　今晩は、いただいたコードを使って、あるExcelの登録「日時」情報を取得し、
KWの後ろにつけることが成功しました。
　もし以下のコードに「Adsl.xls」の登録日時を取得して、その情報をKWの後ろに
つける場合は、どのように修正すればいいでしょうか？
　
Function ExcelExport20Recort()
'要参照 Microsoft DAO x.x Object Library
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsSht As Object
Dim xName As String
Dim RS As DAO.Recordset
Dim QName As String
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim HinaName As String
HinaName = "C:\KW_Hina.xls"
Const lngMaxRow As Long = 20
　　xName = "C:\KW.xls"
　　QName = "クエリ名"
　　LastRow = DCount("*", QName)
　　Set RS = CurrentDb.OpenRecordset(QName, dbOpenSnapshot)
　　Set xlsApp = CreateObject("Excel.Application")
　　Set xlsWkb = xlsApp.Workbooks.Open(HinaName)
　　 With xlsWkb.Sheets("Sheet1")
　　 Do Until RS.EOF
　　　For i = 0 To RS.Fields.Count - 1
　　　.Cells(j * (lngMaxRow + 1) + 1, i + 1).Value = RS(i).Name
　　　Next
　　　.Cells(j * (lngMaxRow + 1) + 2, 1).CopyFromRecordset RS, lngMaxRow
　　　 j = j + 1
　　　Loop
　　　End With
RS.Close: Set RS = Nothing
xlsWkb.SaveAs xName
xlsWkb.Close True: Set xlsWkb = Nothing
xlsApp.Quit: Set xlsApp = Nothing
MsgBox "エクスポート終了"
End Function

480 hits

▼

【6585】レコード数を制御して、Excelへ吐き出し Saiyama 05/10/25(火) 13:11