- 締切済み
ACCESS エクスポート ダイアログ ファイル名取得
ACCESS2003で作成したデータをダイアログで指定したファイル名でエクスポートしたいのですが、上手くできません。 ダイアログが開きその指定したフォルダーにあるエクセルファイルを選択すれば、正常にエキスポートできるのですが、 開いたダイアログにファイル名を入力すると、それ以降動かなくなります。 基本的なことが間違っているのでしょうか?? 詳しい方教えてください。下記にコードした内容を書きました。 よろしくお願いします。 Private Sub cmbTransExcel_Click() On Error GoTo Err_cmbTransExcel_Click Dim fileSaveName As Variant Set dlg = Application.FileDialog(msoFileDialogOpen) With dlg .Title = "チェック" .ButtonName = "エキスポート" .InitialFileName = "C:\Program Files\DATA\" .InitialView = msoFileDialogViewList .AllowMultiSelect = False .Filters.Clear .Filters.Add "xls", "*.xls" End With With dlg If .Show = -1 Then For Each vntPath In dlg.SelectedItems strPath = vntPath Next Else Set dlg = Nothing Exit Sub End If End With Set dlg = Nothing Dim strac As String Dim varxls As Variant Dim strmsg As String strac = "Q_チェック" 'Accessファイルを指定します。 varxls = strPath 'エクセルファイルを指定します。 strmsg = strac & " を、Excelファイルへ出力します。" & Chr(13) & _ "出力先は" & varxls & "、 シート名は" & strac & "です。" & _ Chr(13) & "よろしければ、OKをクリックして下さい。" If MsgBox(strmsg, vbOKCancel) = vbOK Then '最初のデータをフィールド名として使います。 DoCmd.TransferSpreadsheet acExport, _ acSpreadsheetTypeExcel9, strac, varxls, True MsgBox "EXCELの出力が正常終了しました。", vbInformation, "処理終了" End If Exit_cmbTransExcel_click: Exit Sub Err_cmbTransExcel_Click: MsgBox "EXCELの出力が異常終了しました。", vbCritical, "エラー!" Resume Exit_cmbTransExcel_click End Sub
- daikiki
- お礼率20% (1/5)
- オフィス系ソフト
- 回答数1
- ありがとう数1
- みんなの回答 (1)
- 専門家の回答
みんなの回答
- bonaron
- ベストアンサー率64% (482/745)
> Set dlg = Application.FileDialog(msoFileDialogOpen) 「ファイルを開く」 ですから 存在しないファイルは開けませんので、 無いものを指定することはできませんね。 回避策として (1) msoFileDialogSaveAs を使用する。 この場合、フィルタが指定できませんので 拡張子の制御はご自身でやることになります。 (2) FileDialog 以外の方法にする。 お勧めはこちら。 http://www.f3.dion.ne.jp/~element/msaccess/AcTipsGetFileName.html 中ほどにある wh_GetFileName 関数 を「クリップボードにコピー」を クリックしてコピー、 標準モジュールに貼り付け。 クリックイベントで wh_GetFileName 関数を呼び出すように変更。 Sub cmbTransExcelClick() On Error GoTo Err_cmbTransExcel_Click Const DLG_TITLE = "チェック" Const OPEN_TITLE = "エキスポート" Const INITIAL_DIR = "C:\Program Files\DATA" Const FILTER_ = "xls (*.xls)|*.xls" Const FILTER_INDEX = 0 ' 0 行目を既定で選択する。 Dim strPath As String Dim strac As String Dim varxls As Variant Dim strmsg As String ' 保存先ファイル名を取得します。 strPath = wh_GetFileName(, , _ DLG_TITLE, OPEN_TITLE, , INITIAL_DIR, FILTER_, _ FILTER_INDEX, , gfnFlagsOverWritePrompt, _ gfnFOpenSaveAs) If strPath = "" Then Exit Sub End If strac = "TableList" 'Accessファイルを指定します。 varxls = strPath 'エクセルファイルを指定します。 strmsg = strac & " を、Excelファイルへ出力します。" & Chr(13) & _ "出力先は" & varxls & "、 シート名は" & strac & "です。" & _ Chr(13) & "よろしければ、OKをクリックして下さい。" If MsgBox(strmsg, vbOKCancel) = vbOK Then '最初のデータをフィールド名として使います。 DoCmd.TransferSpreadsheet acExport, _ acSpreadsheetTypeExcel9, strac, varxls, True MsgBox "EXCELの出力が正常終了しました。", vbInformation, "処理終了" End If Exit_cmbTransExcel_click: Exit Sub Err_cmbTransExcel_Click: MsgBox "EXCELの出力が異常終了しました。", vbCritical, "エラー!" Resume Exit_cmbTransExcel_click End Sub
関連するQ&A
- CSVデータをAccess2000に自動取得
いつもお世話になっております。 Access2000(OSはWindowsXP)上にボタンを作り、これをクリックするとExcelデータを自動的にインポートするプログラムを作りました。 このプログラムを利用して、エクセルデータではなく、CSVデータをインポートするように変更しようと思っていますが、インターネットを調べても、今一つ要領を得ません。 どの部分をどのように修正すればよいのか、お分かりの方がおられれば、是非ご教授をお願いします。 どうぞ宜しくお願い致します。 (記述したプログラム) ------------------------------------------------------------------ Dim strac As String Dim strxls As String Dim strrange As String Dim strmsg As String strac = "T_回収お客様情報" 'Accessテーブルを指定 strxls = "C:\回収お客様情報.xls" 'エクセルファイルを指定 strmsg = "エクセルファイル" & strxls & "を、" & strac & _ "という名前のファイルとして、データ転送を行います。" & Chr(13) & Chr(13) & _ "よろしければ、OKをクリックしてください。" 'MsgBoxのメッセージ DoCmd.DeleteObject acTable, strac 'テーブルを削除 If MsgBox(strmsg, vbOKCancel, "Microsoft Access Club") = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _ strac, strxls, True MsgBox "データ入力は、正常に完了しました。" End If Exit Sub ---------------------------------------------------------------------
- 締切済み
- その他([技術者向] コンピューター)
- エクセルテーブルをアクセステーブル取込む
エクセルで作成したテーブルデータを取り込むときに余分に空白のレコードが取り込まれてしまうんですが原因が分かりません。 下記コードで処理してます。 Dim strac As String Dim strxls As String Dim strrange As String Dim strMsg As String strac = "T_障害票マスタ" 'Accessテーブルを指定します。 strxls = テキスト0 'エクセルファイルを指定します。 strrange = "T_障害票!" 'データ入力のシート名とセル範囲を指定します。 strMsg = "エクセルファイル" & strxls & " を、Accessファイル " & strac & _ "として、データ入力を行います。" & _ "よろしければ、OKをクリックして下さい。" 'MsgBoxのメッセージ If strxls = "" Then MsgBox "ファイルを選択して下さい。" 'テキストボックスの確認 Exit Sub End If 'DoCmd.DeleteObject acTable, strac 'テーブルを削除します。 If MsgBox(strMsg, vbOKCancel, "import") = vbOK Then '最初のデータをフィールド名として使います。 DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _ strac, strxls, True, strrange MsgBox "インポートは、正常に完了しました。" End If Exit Sub なお取り込むテーブルデータはフィールド行を抜かして常に1レコードだけです。 アクセスでは既存のテーブルに保存してます。 詳しい方お願いします。
- ベストアンサー
- Visual Basic
- エクセルデータをAccessに取り込む時のコツ
いつもお世話になっております。 Access2000(OSはWindowsXP)上にボタンを作り、これをクリックするとExcelデータを自動的にインポートするプログラムを作りました。 プログラムはインターネットを調べて、下記のように書きました。 これはこれで使えるのですが、現在のプログラムの記述では、今回エクセルデータをインポートすると、前回取り込んでいたエクセルデータが一旦削除され、今回取り込んだエクセルデータに置き換わります。 これを、前回取り込んだエクセルデータに、今回取り込んだエクセルデータが追加されるような形になれば、より便利に使えるので、その記述の仕方が分かる方がおられましたら、是非教えて頂きたく思います。 どうぞ宜しくお願い致します。 (記述したプログラム) -------------------------------------------------------------------------------- Dim strac As String Dim strxls As String Dim strrange As String Dim strmsg As String strac = "T_回収お客様情報" 'Accessテーブルを指定 strxls = "C:\回収お客様情報.xls" 'エクセルファイルを指定 strmsg = "エクセルファイル" & strxls & "を、" & strac & _ "という名前のファイルとして、データ転送を行います。" & Chr(13) & Chr(13) & _ "よろしければ、OKをクリックしてください。" 'MsgBoxのメッセージ DoCmd.DeleteObject acTable, strac 'テーブルを削除 If MsgBox(strmsg, vbOKCancel, "Microsoft Access Club") = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel8, _ strac, strxls, True MsgBox "データ入力は、正常に完了しました。" End If Exit Sub --------------------------------------------------------------------------------
- ベストアンサー
- その他(プログラミング・開発)
- エクセルVBA アクセスにインポート
エクセルのデータ(列数、行タイトルは都度かわる)をアクセスにインポートしテーブルを作成したいと思っています。 VBAでこの処理をおこないたく、下記のコードで実行したのですがデバッグがはしってしまいます。 (DとEでデバッグ) 原因がお分かりになる方がおりましたら、教えていただけますでしょうか? 何卒、よろしくお願い申し上げます。 Function ExcelDataImport() 'On Error GoTo エラー Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "T_TESTTABLE" ' --- A varxls = "C:\Users\AC\Desktop\ACTEST\RAWDATA.xlsx" ' ---B strrange = "TEST_RAWDATA" ' --- C strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & _ "へ、データ入力を行います。" & Chr(13) & _ "Excelファイルの入力レンジは、 " & strrange & " です。" DoCmd.DeleteObject acTable, varac ' --- D If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, _ varac, varxls, True, strrange ' -- E MsgBox "データ入力は、正常に完了しました。" End If Exit Function エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & _ "エラー番号:" & Err.Number & Chr(13) & _ "エラー内容:" & Err.Description, vbCritical Exit Function End Function
- ベストアンサー
- オフィス系ソフト
- アクセス(access)からエクセルにエクスポート
アクセスから、エクセルにクエリのデータを出力する際に、 「TransferSpreadsheet」を使用していますが、 そのエラー処理について、教えて下さい。 保存しようとしているファイルが既に開かれている場合に、 処理を中止し、エラーメッセージを出したいのですが、 どのようにすればいいのでしょうか? なお、現在のVBAは次のとおりです。 Private Sub コマンド01_Click() Dim a As String Dim b As Variant a = "Q_一覧表" b = "C:\一覧表.xls" DoCmd.TransferSpreadsheet acExport, _ acSpreadsheetTypeExcel9, a, b, True MsgBox "データを出力しました。" Exit Sub End Sub
- ベストアンサー
- オフィス系ソフト
- Accessへのエクセルデータインポート
Accessへのエクセルデータインポート 環境:Access2000/WinXP アクセス2000の特定テーブルへ、エクセルデータをインポートするよう組んだのですが、新しくデータを追加すると、これより前に入っていたデータがレコードを残して消えてしまいました。 新規データを追加した際にただの追加としたいのですがどこがおかしいのでしょうか。 Private Sub データ登録_Click() Dim objExcel As Object Dim varFilePath As Variant Dim bln As Boolean Dim varac As Variant Dim varxls As Variant Dim strrange As String Dim strmsg As String varac = "受講者情報一覧" Set objExcel = CreateObject("Excel.Application") varFilePath = objExcel.GetOpenFilename("Microsfot Exel (*.xls), *.xls", , "xls選択") If varFilePath <> False Then varxls = varFilePath Else Exit Sub End If Set objExcel = Nothing varxls = varFilePath strrange = "" strmsg = "Excelファイル" & varxls & " を、Accessテーブル " & varac & "へ、インポートします。" DoCmd.DeleteObject acTable, varac If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acImport, acSpreadsheetTypeExcel9, varac, varxls, True MsgBox "正常にインポート完了しました。" End If Exit Sub エラー: MsgBox "予期せぬエラーが発生しました。" & Chr(13) & "エラー番号:" & Err.Number & Chr(13) & _ "エラー内容:" & Err.Description, vbCritical Exit Sub End Sub
- ベストアンサー
- Visual Basic
- 特定の列・行をテキストファイルに保存させたい
VB6.0とSPREAD6.0で スプレッドシート内のデータをCSVファイル化させるプログラムを組んでいます Private Sub Command1_Click() Dim blnCHECK As Boolean Dim strMsg As String Dim strDate As String Dim lngResponse As Long Dim ret As Boolean strDate = Format(Now(), "yyyymmddhhmmss") 'ファイル名 With spdTarget 'スプレッドシート .Row = 1 While .Row <= .MaxRows .Col = LNG_SPD_COL_CHECK 'チェックボックス If .Value <> 0 Then blnCHECK = True strMsg = "選択データをファイル作成しますか?" lngResponse = MsgBox(strMsg, vbQuestion + vbYesNo, "Exit Dialog") If lngResponse = vbYes Then ret = spdTarget.ExportToTextFile _ ("C:\Documents and Settings\ファイル作成先\" & strDate & ".csv", "", _ ",", Chr(13), ExportToTextFileColHeaders + _ ExportToTextFileCreateNewFile, _ "C:\Documents and Settings\ファイル作成先\" & strDate & ".log") Else Exit Sub End If End If .Row = .Row + 1 Wend End With If blnCHECK = False Then MsgBox "作成対象データを選んで下さい", vbExclamation End If End Sub 上記のコードだと表内の全てのデータをCSVファイル化させる事はできるのですが 特定の行(1列目のチェックボックスで指定)や特定の列のみを選択してファイル化させる といった動きにさせるには、どうしたら良いのでしょうか?
- ベストアンサー
- Visual Basic
- ファイルが既に開いているかどうかを取得するには
Sub Sample1() Dim App As Object Dim MyFileName As String Set App = CreateObject("Excel.Application") MyFileName = "C:\Users\test.xlsm" With App .Workbooks.Open Filename:=MyFileName .Visible = True If .ReadOnly Then MsgBox "既に開いています" App.Quit '既に開いているのなら、閉じる End If End With End Sub このようなコードを作ったのですが、どうやらIf .ReadOnly Thenの部分が間違っているようです。 エラーになります。 既にファイルが開いているか、読み取り専用かどうかを取得するコードをご教授ください。
- ベストアンサー
- Excel(エクセル)
- ACCESS クエリ→フォーム フィルターをかけたデータのみエクスポートしたい
よろしくお願いします。 クエリのデータをフォームで表示し、その時にコンボボックスで表示するデータを指定し抽出・表示しています。([授業名]フィールドのコンボボックスで、指定した授業のみ抽出します) 最終的に抽出したデータを、コマンドボタンでエクスポートできるようにしたいのですが、私の記述方法では「全てのクエリのデータ」がエクスポートされてしまいます。 どのような方法でもいいのですが、指定したデータ([授業名])のみエクスポートする方法はないでしょうか・・・? *データエクスポートのVBA記述内容* Private Sub cmdデータ出力_Click() '名簿データのエクスポート Dim msg As String msg = MsgBox("名簿データを出力します。", vbYesNo, "出力確認") If msg = vbYes Then 'どの場所にデータをエクスポートするか指定 DoCmd.TransferSpreadsheet acExport, , "Q_受講者名簿用", _ "Y:\○○課\住所録データエクスポート場所\" & "受講者名簿【ACCESSより】.xls", True answer = MsgBox("受講者名簿データを出力しました", vbOKOnly, "データの出力の確認") cancel = True End If End Sub *ちなみに、フォーム上でフィルターをかけたVBAは* Private Sub cmd名簿_Click() Dim stList As String Dim stFil As String If combo1 <> "" Then stFil = "[授業名]='" & combo1 & "'" End If Me.Filter = stFil Me.FilterOn = True End Sub
- ベストアンサー
- オフィス系ソフト
- アクセスからエクセルへインポートの際に
アクセスからエクセルへクエリの結果をインポートしています。 そこでワークシートができるのですが、その後、そのワークシート が残るので同じ処理をした際に、同じ名前のワークシートに上書き すると思っていたのですが、新たにワークシートを作成して しまい困っています。 VarAccess = "入力禁止LEJOUR" の部分がワークシート名になりますが 同じ処理をすると入力禁止LEJOUR1というワークシートが横に できてしまいます。 これを入力禁止LEJOURのシートに上書きさせるには どんなコードを使用したらいいでしょうか? 教えてください。 よろしくお願い致します。 Private Sub コマンド15_Click() On Error GoTo エラー Dim VarAccess As Variant Dim VarExcelpass As Variant Dim strmsg As String VarAccess = "入力禁止LEJOUR" VarExcelpass = "\\Shiob030\共有\生産戦略事業部\03.生産L.C.海\B.指図進捗表(月単位)\07\SS\07SS-LE JOUR.xls" strmsg = VarAccess & "を、Excelファイルへ出力します。" & _ Chr(13) & "出力先は" & VarExcelpass & "、 シート名は" _ & VarAccess & "です。" & Chr(13) & "よろしければ、OKをクリックして下さい。" If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel9, VarAccess, VarExcelpass, True MsgBox "データ出力は、正常に完了しました。" End If Exit Sub エラー: If Err.Number = 3044 Then MsgBox "Excelファイルのパス指定が間違っています。", vbCritical Else MsgBox "予期せぬエラーが発生しました。", vbCritical End If End Sub
- ベストアンサー
- オフィス系ソフト
お礼
早々のご回等ありがとうございます。 ご指摘の通りコードしたら、やりたいと思っていたことができました。 でも、正直内容のほうはよくわかりません。 ご紹介して頂いたサイト等を参考に勉強していきたいと思います。 本当にありがとうございました。