• ベストアンサー

ダイアログボックスを表示したい。

下記処理コードを実行したときに、 ファイル選択のダイアログ表示をさせるのにファイル名を決まった形にしないと駄目みたいです。 (例)strLookupFileName = "abcms_E000_H*.csv;" ファイル名に関係なくダイアログを表示させるにはどうしたら良いのでしょうか？ 今現在、ファイル名を適当なものに変えると「キャンセルされました。」のメッセージボックスが表示されます。 例：strLookupFileName = "abc明細.xls"←エラー（これでも可に） (処理コード) 'ファイル選択 strFileName = FileNameGet(Me.Hwnd, strHomeDirectory, strLookupFileName, "CSV ファイル", "ファイル選択") If strFileName = "" Then MsgBox "キャンセルされました。", vbInformation + vbOKOnly, " " Exit Sub End If ↓ Public Function FileNameGet(Owner As Variant, DefaultDirectory As String, DefaultFilter As String, DefaultFilterName As String, Title As String) As Variant On Error GoTo Err Dim dlg As OPENFILENAME Dim rslt As Long dlg.hwndOwner = Owner dlg.hInstance = 0 'dlg.nFilterIndex = 0 dlg.lpstrTitle = Title & Chr(0) & Chr(0) dlg.lpstrFileTitle = Space(256) & Chr(0) & Chr(0) dlg.lpstrInitialDir = DefaultDirectory & Chr(0) & Chr(0) dlg.lpstrFile = DefaultFilter & Space(256) & Chr(0) & Chr(0) dlg.lpstrFilter = DefaultFilter & Chr(0) & Chr(0) dlg.nMaxFile = Len(dlg.lpstrFile) dlg.nMaxFileTitle = Len(dlg.lpstrFileTitle) dlg.lStructSize = Len(dlg) rslt = GetOpenFileName(dlg) If rslt = 0 Then FileNameGet = "" Exit Function End If 'ファイル名チェック If IsNull(dlg.lpstrFile) Or dlg.lpstrFile = "" Then MsgBox "ファイル名が取得できませんでした。", vbInformation + vbOKOnly, " " FileNameGet = Null Exit Function End If 'FileNameGet = StrConv(MidB(StrConv(dlg.lpstrFile, vbFromUnicode), 1, (dlg.nFileExtension + 3)), vbUnicode) FileNameGet = Left$(dlg.lpstrFile, InStr(dlg.lpstrFile, vbNullChar) - 1 On Error GoTo 0 Exit Function Err: MsgBox Err.Description End Function

質問者が選んだベストアンサー

  • ベストアンサー
  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.4

nMaxFileに与える数値を LenB(dlg.lpstrFile) といった具合にすればいいようですよ DLLを呼び出した際にエラーになるなら ErrオブジェクトのLastDllErrでエラーコードを取得して PlatformSDKの『System Error Code』などを参照し原因を究明しましょう #1の回答は的外れでしたね m(__)m

n_c63amg
質問者

お礼

有り難う御座いました。 お蔭様で解決し、ダイアログボックスが表示される 様になりました。

その他の回答 (3)

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.3

先の回答で誤りがありました。 "CSVファイル" & Chr(0) & "*.csv" & Chr(0) & "全てのファイル" & "*.*" & String(2, Chr(0)) 　　　　　　　↓ "CSVファイル" & Chr(0) & "*.csv" & Chr(0) & "全てのファイル" & Chr(0) & "*.*" & String(2, Chr(0))

n_c63amg
質問者

お礼

有り難う御座います。 助かりました。

  • nda23
  • ベストアンサー率54% (777/1415)
回答No.2

(1)以下の後方のChr(0)×2は不要です。 dlg.lpstrTitle = Title & Chr(0) & Chr(0) dlg.lpstrFileTitle = Space(256) & Chr(0) & Chr(0) dlg.lpstrInitialDir = DefaultDirectory & Chr(0) & Chr(0) dlg.lpstrFilter = DefaultFilter & Chr(0) & Chr(0) (2)Space(256)はString(256, Chr(0))が正しい。 dlg.lpstrFile = DefaultFilter & Space(256) & Chr(0) & Chr(0) ※後方のChr(0)×2も不要です。 (3)フラグは？ dlg.flagsは0でも動きますが、普通はOFN_xxxの定数を組み合わせます。 (4)フィルタの使い方が違います。 フィルタは「表示名1x実フィルタ1x表示名2x実フィルタ2x・・・xx」　x=Chr(0) 正しくは "CSVファイル" & Chr(0) & "*.csv" & Chr(0) & "全てのファイル" & "*.*" & String(2, Chr(0)) (5)Lenについて Lenは文字数を返します。nMaxFile等はバイト数なので漢字を含むパス名では正しくありません。 dlg.lpstrFile = DefaultFilter & String(256, Chr(0))なら dlg.nMaxFile = lstrlen(DefaultFilter) + 256です。 lstrlenはWndowsAPIにあります。

n_c63amg
質問者

お礼

細かくご指導いただき有り難う御座いました。 くだらない質問ばかりですが、 今後ともよろしくお願いします。

  • redfox63
  • ベストアンサー率71% (1325/1856)
回答No.1

lpstrFilterメンバーに与えるデータを "CSVファイル(*.csv)|*.csv" といった具合に変更しても同じでしょうか …

n_c63amg
質問者

お礼

2度のご回答有り難う御座いました。 また宜しくお願いします。

n_c63amg
質問者

補足

早速のご回答有り難うございます。 dlg.lpstrFilter = "CSVファイル(*.csv)|*.csv"にしましたが、 変わらないです。 strLookupFileName = "abcms_E000_H*.csv;"といった形 ファイルを探しているみたいです。 ファイル名を任意の形にしてやったらどうなのかと思い、 strLookupFileName = "abc明細.csv"にすると、 「キャンセルされました。」のメッセージボックスが表示されます。 どこが悪いのでしょうか？

  1. カテゴリ
  2. [技術者向] コンピューター
  3. プログラミング・開発
  4. Visual Basic

関連するQ&A

  • 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 "ＥＸＣＥＬの出力が正常終了しました。", vbInformation, "処理終了" End If Exit_cmbTransExcel_click: Exit Sub Err_cmbTransExcel_Click: MsgBox "ＥＸＣＥＬの出力が異常終了しました。", vbCritical, "エラー！" Resume Exit_cmbTransExcel_click End Sub

  • VBAのキャンセル処理

    下記のVBAでファイルを出力することはできるようになったのですが、 出力するときに[キャンセル]を押しても"MsgBox ：Excelファイルへの出力が完了しました。"が表示されてしまいます。 「キャンセル」した場合は、このメッセージが表示されないようにできないでしょうか？ Private Sub Image_Export_Click() On Error GoTo Err_FileDialog_Click 'ファイル出力 Dim strFileName As String Dim ExpFileName As String ExpFileName = "T_master_" & Format(Now(), "yyyymmdd") strFileName = GetFileName(False, "MicrosoftExcel ブック (*.xls)|*.xls", "", ExpFileName & ".xls") If Len(strFileName) = 0 Then 'キャンセルボタンが押されたときの処理を記述 MsgBox "キャンセルが押されました。" Else DoCmd.TransferSpreadsheet acExport, acSpreadsheetTypeExcel8, "T_master", strFileName & ".xls", True End If MsgBox "Excelファイルへの出力が完了しました。", , "出力完了" Exit_FileDialog_Click: Exit Sub Err_FileDialog_Click: MsgBox "予期せぬエラーが発生しました" & Chr(13) & _ "エラーナンバー：" & Err.Number & Chr(13) & _ "エラー内容：" & Err.Description, vbOKOnly End Resume Exit_FileDialog_Click End Sub

  • ＡＣＣＥＳＳを活用して商品変動を捉えたい(5再再）

    http://okwave.jp/qa/q8782706.html 上記について標準モジュールも作成して、先のクエリーを実行しましたが、 その際に ！コンパイル　エラー： ユーザー定義型は定義されていません。 と出ます。 5行目の rst As ADODB.Recordset 箇所が反転されています。 一回でできるのは魅力なのですが、本当に実装できるのでしょうか。 （クエリーはたしかに保存できました） Public Function DBLookup(ByVal strQuerySQL As String, _ 　　　　　　　　　　　　　Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup 　　Dim DataValue 　　Dim rst　　　　 As ADODB.Recordset 　　Set rst = New ADODB.Recordset 　　With rst 　　　　.Open strQuerySQL, _ 　　　　　　　CurrentProject.Connection, _ 　　　　　　　adOpenStatic, _ 　　　　　　　adLockReadOnly 　　　　If Not .BOF Then 　　　　　　.MoveFirst 　　　　　　DataValue = .Fields(0) 　　　　End If 　　End With Exit_DBLookup: On Error Resume Next 　　rst.Close 　　Set rst = Nothing 　　DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue) 　　Exit Function Err_DBLookup: 　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _ 　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _ 　　　　　 "・SQL Text=" & strQuerySQL, _ 　　　　　 vbExclamation, " 関数エラーメッセージ" 　　Resume Exit_DBLookup End Function Public Function DBLookup(ByVal strQuerySQL As String, _ 　　　　　　　　　　　　　Optional ByVal ReturnValue = Null) As Variant On Error GoTo Err_DBLookup 　　Dim DataValue 　　Dim rst　　　　 As ADODB.Recordset 　　Set rst = New ADODB.Recordset 　　With rst 　　　　.Open strQuerySQL, _ 　　　　　　　CurrentProject.Connection, _ 　　　　　　　adOpenStatic, _ 　　　　　　　adLockReadOnly 　　　　If Not .BOF Then 　　　　　　.MoveFirst 　　　　　　DataValue = .Fields(0) 　　　　End If 　　End With Exit_DBLookup: On Error Resume Next 　　rst.Close 　　Set rst = Nothing 　　DBLookup = IIf(Len(DataValue & ""), DataValue, ReturnValue) 　　Exit Function Err_DBLookup: 　　MsgBox "SELECT 文の実行時にエラーが発生しました。(DBLookup)" & Chr$(13) & Chr$(13) & _ 　　　　　 "・Err.Description=" & Err.Description & Chr$(13) & _ 　　　　　 "・SQL Text=" & strQuerySQL, _ 　　　　　 vbExclamation, " 関数エラーメッセージ" 　　Resume Exit_DBLookup End Function

  • VB6.0で、ファイルのマルチセレクトダイアログでエラーがでます。

    VB6.0で、ファイルのマルチセレクトダイアログでエラーがでます。 ファイルを10個ほど選択ならエラーがでません。 250個ほどファイルを選択したいのですが、 コードを何度みなおしてもわかりません。 どなたか、どこをどう修正したらよいのかアドバイスをいただけませんでしょうか。 お手数をおかけしますがよろしくお願いします。 エラー箇所は下部の For i = 1 To UBound(GetFileName) です。 Public Function apiGetOpenFileName(nHandle As Long, nFilter As String, nDir As String) As Variant Dim OFN As OPENFILENAME 'OPENFILENAME構造体 Dim Ret As Long '戻り値 With OFN '構造体の設定 .Flags = OFN_PATHMUSTEXIST Or _ OFN_FILEMUSTEXIST Or _ OFN_HIDEREADONLY Or _ OFN_ALLOWMULTISELECT Or OFN_EXPLORER 'マルチセレクト追加 .hInstance = App.hInstance 'インスタンスハンドルを設定 .hwndOwner = nHandle 'ウインドウハンドルを設定 .lpstrTitle = "ファイルを開く" 'コモンダイアログのタイトルを設定 .lpstrFilter = nFilter 'フィルタを設定 .lStructSize = Len(OFN) '構造体のサイズを設定 .nMaxFile = 257 'ファイル名のバッファのサイズを設定 .lpstrFileTitle = String(257, Chr(0)) 'フルパス用のバッファを確保 .nMaxFileTitle = 257 'フルパス用のバッファのサイズを設定 .lpstrFile = String(257, Chr(0)) 'ファイル名のバッファを確保 .lpstrInitialDir = nDir 'デフォルトのディレクトリを指定 End With Ret = GetOpenFileName(OFN) '「ファイルを開く」ダイアログボックスを表示する If Ret = 0 Then '[キャンセル]を押した時 apiGetOpenFileName = vbNullString Exit Function Else '[OK]を押した時 apiGetOpenFileName = Split(OFN.lpstrFile, Chr(0)) End If End Function ' ファイル名を取得する ・・・コード省略 Dim GetFileName As Variant 'ファイル名(フルパス) GetFileName = apiGetOpenFileName(Form1.hWnd, strFilter, strDir) 'ダイアログ表示 'ファイル名取得 j = 1 For i = 1 To UBound(GetFileName)　←ここでエラーが出ます If GetFileName(i) <> "" Then strDFname(j) = GetFileName(i) j = j + 1 End If Next i

  • エクセル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" ' ---Ｂ 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

  • GetOpenFileName 開かない

    win7 32bitで使用していたVBAが、win10 64bitで動作せず、困っております。 ダイアログが開かないまま先に進んでしまうのですが、どのように修正すれば良いでしょうか？ #If Win64 Then Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( pOpenFileName As OPENFILENAME) As Long #Else Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" ( pOpenFileName As OPENFILENAME) As Long #End If Type OPENFILENAME lStructSize As Long hwndOwner As LongPtr hInstance As LongPtr lpstrFilter As String lpstrCustomFilter As Long nMaxCustrFilter As Long nFilterIndex As Long lpstrFile As String nMaxFile As Long lpstrFileTitle As String nMaxFileTitle As Long lpstrInitialDir As String lpstrTitle As String Flags As Long nFileOffset As Integer nFileExtension As Integer lpstrDefExt As String lCustrData As LongPtr lpfnHook As LongPtr lpTemplateName As Long End Type Public Const OFN_ALLOWMULTISELECT = &H200 Public Const OFN_CREATEPROMPT = &H2000 Public Const OFN_EXPLORER = &H80000 Public Const OFN_FILEMUSTEXIST = &H1000 Public Const OFN_HIDEREADONLY = &H4 Public Const OFN_NOCHANGEDIR = &H8 Public Const OFN_NODEREFERENCELINKS = &H100000 Public Const OFN_NONETWORKBUTTON = &H20000 Public Const OFN_NOREADONLYRETURN = &H8000 Public Const OFN_NOVALIDATE = &H100 Public Const OFN_OVERWRITEPROMPT = &H2 Public Const OFN_PATHMUSTEXIST = &H800 Public Const OFN_READONLY = &H1 Public Const OFN_SHOWHELP = &H10 Public Const OFN_EXTENSIONDIFFERENT = &H400 Public Function GetFileName(pstrDir As String, pstrFile) As String Dim pOpenFileName As OPENFILENAME Dim lngRet As Long pOpenFileName.hwndOwner = Application.hWndAccessApp pOpenFileName.hInstance = 0 ' pOpenFileName.lpstrFilter = "CSVファイル (*.xlsx)" & String(1, vbNullChar) & "*.xlsx" & String(2, vbNullChar) ' pOpenFileName.lpstrFilter = "全てのファイル (*.*)" & String( 1, vbNullChar) & "*.*" & String(2, vbNullChar) pOpenFileName.lpstrCustomFilter = 0 pOpenFileName.nMaxCustrFilter = 0 pOpenFileName.nFilterIndex = 1 pOpenFileName.lpstrFile = String(511, vbNullChar) pOpenFileName.nMaxFile = 511 pOpenFileName.lpstrFileTitle = String(512, vbNullChar) pOpenFileName.nMaxFileTitle = 511 pOpenFileName.lpstrInitialDir = pstrDir pOpenFileName.lpstrTitle = String(1, vbNullChar) pOpenFileName.nFileOffset = 0 pOpenFileName.nFileExtension = 0 pOpenFileName.lpstrDefExt = String(1, vbNullChar) pOpenFileName.lCustrData = 0 pOpenFileName.lpfnHook = 0 pOpenFileName.lpTemplateName = 0 pOpenFileName.lStructSize = Len(pOpenFileName) pOpenFileName.Flags = OFN_HIDEREADONLY _ Or OFN_EXPLORER lngRet = GetOpenFileName(pOpenFileName) GetFileName = Left(pOpenFileName.lpstrFile, _ InStr(pOpenFileName.lpstrFile, vbNullChar) - 1) If Len(GetFileName) Then pstrFile = Left(pOpenFileName.lpstrFileTitle, _ InStr(pOpenFileName.lpstrFileTitle, vbNullChar) - 1) pstrDir = Left(GetFileName, Len(GetFileName) - Len(pstrFile) - 1) End If End Function '実行プロシージャ Private Sub CmdlgTest() Dim strPath As String, strfile As String Debug.Print GetFileName(strPath, strfile) End Sub

  • 指定ファイルのみ読み込んで表示する

    現在、以下のコードで指定フォルダー内の全ファイルをA２以下に読み込んでいます。 これでは、処理する必要のないファイルまで読み込まれてしまいます。 （そのため、現在は処理必要ないファイルは手動でA列から削除しています。） Set dlg = Application.FileDialog(msoFileDialogFolderPicker)　を Set dlg = Application.FileDialog(msoFileDialogFilePicker)　に変更すると ユーザーがファイルを処理が必要なファイルのみ選択できそうですが その場合、どのように変更すれば良いですか　？ ’-------------------------------------------------------------- Option Explicit Public dlg As FileDialog Public fol_path As String 'フォルダのフルパス Sub フォルダを指定してファイル名一覧を作成する() Dim f_name As String 'ファイル名 Dim i As Long 'ファイル名を出力する行番号 '書き出しセル初期化 Range("A2:B100").ClearContents 'フォルダを指定するモードでFileDialogを表示 Set dlg = Application.FileDialog(msoFileDialogFolderPicker) '読み込み初期フォルダーの指定 dlg.InitialFileName = "C:\Users\Nubo\Desktop\Temp\" If dlg.Show = False Then MsgBox "処理はキャンセルされました。" Exit Sub Else End If fol_path = dlg.SelectedItems(1) '指定されたフォルダのフルパスを変数に格納 f_name = Dir(fol_path & "\*") 'Dir関数を使って、指定されたフォルダ内の一つ目のファイル名を取得 If f_name = "" Then MsgBox fol_path & " にはファイルが存在しません。" Exit Sub End If 'シートに書き出す Range("C1").Value = fol_path & "のファイル一覧" Range("A1").Value = "現在のファイル名" '見出し行の表示（太字、フォントサイズ 12) With Range("A1:B1") .Font.Bold = True .Font.Size = 12 End With 'A2セルから下にファイル名を書き出し i = 2 Do Until f_name = "" Cells(i, "A").Value = f_name i = i + 1 '次のファイル名を取得 f_name = Dir Loop 'セルの内容に合わせて列幅を自動調整する Range("A:D").EntireColumn.AutoFit MsgBox Sheets("DATA").Name & "にファイル名一覧を作成しました。" & Chr(13) & _ "変名に必要ないファイル名があれば削除してください。" End Sub ’----------------------------------- Office 2021,Windows_11

  • AccessのVBAに関しての質問です。

    クエリで抽出したファイルをCSVで出力させ、出力したファイル名を「連番&ファイル名」の形にしたく 下記のコードを使用しました。 6ファイルは出力は成功したのですが、7ファイル目を出力しようとしたところ、「＃6：オーバーフロウしました。」とエラーがでてきてしまいます。 原因やここのコードを変えれば直るというのが、お分かりになる方がいればご教示頂けますでしょうか。 初心者ですのでコードも書いて頂けると非常に助かります。 Private Sub コマンド4_Click() On Error GoTo ErrorTrap Dim varAccess As Variant Dim varCPass As Variant Dim strmsg As String varAccess = "ASN抽出" Dim FolderPass As String Dim FileName As String Dim CheckCount As Integer FolderPass = "C:￥Users￥エクスポート￥" FileName = "_STORE_ASN_TRN.csv" CheckCount = 0 Do Until Dir(FolderPass & FileName) = "" CheckCount = CheckCount + 1 FileName = Format(CheckCount, Len(CStr(CheckCount)) + 1) & "_STORE_ASN_TRN" & ".csv" Loop varTextPass = FolderPass & FileName strmsg = "csvファイルへ出力します。" & Chr(13) & _ "出力先は" & varTextPass & "です。" & _ "よろしければ、OKをクリックして下さい。" If MsgBox(strmsg, vbOKCancel) = vbOK Then DoCmd.TransferText acExportDelim, , varAccess, varTextPass, False MsgBox "データ出力は、正常に完了しました。" End If Exit Sub ErrorTrap: If Err.Number = 3044 Then ' MsgBox "パス指定が誤っています。", vbCritical Else MsgBox "予期せぬエラーが発生しました。（#" & Err.Number & " : " & Err.Description & "）", vbCritical End If End Sub

  • ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルを

    ダイアログボックスからフォルダ名を取得し、フォルダ内のCSVファイルをすべてアクセスのテーブルにインポート使用と思っています。 ところがCSVファイルの数の分だけ、１つめのCSVファイルの中身が繰り返しインポートされてしまっています。 どの部分に誤りがあるのでしょうか？ お知恵を拝借できますでしょうか・・・。 コードは以下になります。 Private Sub cmd06_Click() Dim MyFile As String Dim MyName As String Dim MyName02 As String Dim strFolderName As String strFolderName = GetFolderName() 'フォルダ選択ダイアログを表示 If Len(strFolderName) > 0 Then '選択結果を評価 MyFile = strFolderName & "\*.csv" '【拡張子csvのファイルのみ取得】 MyName = Dir(MyFile, vbNormal) MyName02 = "\" & MyName Do While MyName <> "" If MyName <> "." And MyName <> ".." Then If GetAttr(strFolderName & "\" & MyName) <> vbDirectory Then DoCmd.TransferText acImportFixed, "T03_インポート定義", "T03_全CSVデータ", strFolderName & MyName02, False, "" '【取得したファイルをインポート】 End If End If MyName = Dir Loop Else MsgBox "フォルダは選択されませんでした" End If MsgBox "データのインポートが終了しました" End Sub

  • Access テキスト　インポート

    現在指定したファイルしかインポートしが出来ないのでこれを 指定したファイルをインポートしたいのですがどのようすれは、いいでしょうか？よろしくお願いします。 Private Sub コマンド5_Click() On Error Resume Next Dim MsgNo As Integer Dim Msg1, Msg2, Msg3 As String Dim su As String Dim cut As Integer Dim fd As String Dim suu As String Dim db As Database Dim d1 As Recordset Msg1 = " インポートを開始します。" Msg2 = "「DAT」ファイルがありません。" Msg3 = "「DAT」ファイルを c:\DATデータにコピーし、再度実行して下さい。" MsgNo = MsgBox(Chr(9) & Msg1 & Chr(9), 1) If MsgNo = 2 Then 'キャンセルボタンで終了 GoTo Exit_インポート_Click End If EmptyAllTable 'テーブルクリア Set db = CurrentDb Set d1 = db.OpenRecordset("t_製品データ") fd = Dir("C:\DATデータ\*.dat") If fd = "" Then 'ファイルがなければ、メッセージを表示、処理を戻します。 Beep MsgNo = MsgBox(Msg2 & Chr(13) & Chr(10) & Chr(13) & Chr(10) & Msg3, 16) GoTo Exit_インポート_Click End If

注目のQ&A

カテゴリ

専門家に質問してみよう

職業から探して質問する

あなたにピッタリな商品が見つかる！ OKWAVEセレクト

質問する