Access VBA質問箱 IV

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

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


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

1866 / 9994

←次へ　｜　前へ→


	【11410】excel出力先をデスクトップに指定する

VBA初心者 - 10/1/21(木) 21:03 -


	引用なし

	パスワード

こんばんわ。
VBA初心者です。
OS:XP
office:Access2007

フォームからエクセルファイルでデータを出力しているのですが、
出力先を、使用しているユーザのデスクトップに指定するにはどうしたら
いいでしょうか。
例：c:\document and setting\users\デスクトップ\に出力したいです。
下記に一連のコードを記載しました。
　xlsFileName = "C:\" & Format(Date, "yyyy_mm_dd") & "ホストデータ.xls"
のところを
　「xlsFileName = "SpecialFolders("Desktop"):\" & Format
　　(Date, "yyyy_mm_dd") & "ホストデータ.xls"」として、
使用しているユーザのデスクトップに保存されるでしょうか。
お忙しい中申し訳ないですが、どなたかご教授をお願いします。

----------------------------------------------------------------

Private Sub コマンド_Click()
Dim DB As DAO.Database
Dim RS As DAO.Recordset
Dim strSQL As String
Dim strWhere As String
Dim xlsApp As Object
Dim xlsWkb As Object
Dim xlsFileName As String
Dim i As Long

　　Set DB = CurrentDb
　　xlsFileName = "C:\" & Format(Date, "yyyy_mm_dd") & "ホストデータ.xls"
　　
　　'もし Filterプロパティになにも記述されていなかったら
　　'フォームに表示されている全データを出力するようにします。
　　
　　If Me.Filter = "" Then
　　　　strWhere = True
　　Else
　　　　strWhere = Me.Filter
　　End If

　　
　　'変数に SQL文を代入します。
　　'Filter プロパティに記述されているものを抽出条件とします。
　　
　　strSQL = ""
　　strSQL = strSQL & " SELECT 登録日 "
　　strSQL = strSQL & "　　　, AB_COMM AS 事業所 "
　　strSQL = strSQL & "　　　, NEW_HOSTNAME AS 新ＰＣ名 "
　　strSQL = strSQL & "　　　, MEMO5 As 事項 "
　　strSQL = strSQL & " FROM " & Me.RecordSource & " "
　　strSQL = strSQL & " WHERE " & strWhere

　　'レコードセットに対象のデータを代入します
　　Set RS = DB.OpenRecordset(strSQL, dbOpenSnapshot)
　　　　
　　'以下Excelの操作------------------------------------------
　　Set xlsApp = CreateObject("Excel.Application")
　　　　xlsApp.Visible = True
　　
　　Set xlsWkb = xlsApp.workbooks.Add
　　　　With xlsWkb.Sheets("Sheet1")
　　　　
　　　　For i = 0 To RS.Fields.Count - 1
　　　　　　.Range("A1").Offset(0, i).Value = RS.Fields(i).Name
　　　　Next i
　　　　
　　　　.Range("A2").CopyFromRecordset RS
　　　　.Columns("A:H").AutoFit
　　　　End With
　　　　
　　　　xlsWkb.SaveAs xlsFileName
　　xlsWkb.Close: Set xlsWkb = Nothing
　　xlsApp.Quit:　Set xlsApp = Nothing
　　
　　MsgBox "出力が終了しました"
　　　　
End Sub

1,737 hits

▼

【11410】excel出力先をデスクトップに指定する VBA初心者 10/1/21(木) 21:03