• 締切済み

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

みんなの回答

  • m3_maki
  • ベストアンサー率64% (295/459)
回答No.5

直接の回答ではありませんが なぜ FileDialog を使わないの? Access 2000 以前じゃないですよね? FileDialog プロパティ (Access) https://docs.microsoft.com/ja-jp/office/vba/api/access.application.filedialog Office のバージョンは異なるかもしれませんが、分かりやすいサンプル。 Officeオブジェクトを使った"ファイル選択"ダイアログ https://tsware.jp/tips/tips_221.htm 64ビットの Office で動くかどうか知りませんが、 試してみる価値は有るかと思います。

ampm2007
質問者

お礼

ですよねww 私が作ったものではないaccessを64bitでも動くように…との依頼なので、出来るだけ元の形を維持したまま使えないか?と模索しております。 動かない理由が分からないままなのもモヤモヤするので(ネット検索した限りでは動きそうでしたし)、そのまま使える解決策があるなら、知りたいと思いました。 有難うございます。

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.4

外しているかも知れませんが、こちらの情報と比較したところ、構造体の宣言部に違いがありました。 https://www.ilovex.co.jp/blog/system/i/systemdevelopment/winapi32bit64bit.html String型で宣言すべきパラメータがLong型になっている。 nMaxCustFilter が nMaxCustrFilter になっている。

ampm2007
質問者

補足

参考サイトに習って該当箇所を修正し、ご指摘のnMaxCustFilter(他にもCust がCustrになっている箇所も含めて)も修正して実行してみましたが、挙動に変化はありませんでした。

  • masnoske
  • ベストアンサー率35% (67/190)
回答No.3

> 64bit のOSなので、64bitのソフトがインストールされていると思います。 思い込みではなく、確認されたほうが良いと思います。 ヘルプを見れば、32ビットか64ビットかをすぐに確認できます。

ampm2007
質問者

補足

64bit版がインストールされておりました。

  • oboroxx
  • ベストアンサー率40% (317/792)
回答No.2

No.1です。 64bitOSでも、多くの人はまだ32bitのOfficeをインストールしていると思いますよ。 過去のOfficeのアドイン等の資産が32bitのままのが多いので、それらは32bitのOfficeでないと使えないのです。 64bitで使えるようにするのは参考URLを見てみてください。 http://ivystar.jp/ms-office/access/%E6%97%A7access%E3%82%9264bit-win7access-2010%E3%81%A7%E9%96%8B%E3%81%84%E3%81%9F%E6%99%82%E3%81%AEapi%E3%82%A8%E3%83%A9%E3%83%BC%E3%81%AE%E5%AF%BE%E5%87%A6%E6%96%B9%E6%B3%95/

ampm2007
質問者

お礼

参考URLを有難うございます。 しかしながら、既に閲覧済みのサイトでした。

  • oboroxx
  • ベストアンサー率40% (317/792)
回答No.1

Windows10にインストールされているAccessは32bitでしょうか? もしかしたら、64bitでインストールされていると動かないのかもしれません。

ampm2007
質問者

補足

64bit のOSなので、64bitのソフトがインストールされていると思います。 なので、64bitで動作させる為の修正箇所と、方法が知りたいです。

関連するQ&A

  • 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

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

    下記処理コードを実行したときに、 ファイル選択のダイアログ表示をさせるのにファイル名を決まった形にしないと駄目みたいです。 (例)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

  • ファイル名の取得について

    以下のサンプルで、選択したファイル名を任意の変数に取得したいのですが、どこに手を加えると取得できますでしょうか。 void OpenImgFiles(HWND hWnd) {   OPENFILENAME ofn;   memset(&ofn, 0, sizeof(OPENFILENAME));   ofn.lStructSize = sizeof(OPENFILENAME);   ofn.hwndOwner = hWnd;   ofn.lpstrFilter = "BMP files(*.bmp)\0*.bmp\0All Files(*.*)\0*.*\0\0";   ofn.lpstrFile = FileName;   ofn.nMaxFile = MAX_PATH;   ofn.Flags = OFN_FILEMUSTEXIST;   ofn.lpstrDefExt = "bmp";   ofn.nMaxFileTitle = 64;   ofn.lpstrFileTitle = FileTitle;   ofn.lpstrTitle = "ファイルを開く";   if (GetOpenFileName(&ofn)) {     show = 1;     InvalidateRect(hWnd, NULL, TRUE);   }   return; } ひょっとして簡単すぎるのかも知れませんが・・・ どうかよろしくお願いします。

  • bmpファイルビューアを作るため

    猫のサイトのコードを使って void OpenImgFiles(HWND hWnd) { OPENFILENAME ofn; memset(&ofn, 0, sizeof(OPENFILENAME)); ofn.lStructSize = sizeof(OPENFILENAME); ofn.hwndOwner = hWnd; ofn.lpstrFilter = "BMP files(*.bmp)\0*.bmp\0All Files(*.*)\0*.*\0\0"; ofn.lpstrFile = FileName; ofn.nMaxFile = MAX_PATH; ofn.Flags = OFN_FILEMUSTEXIST; ofn.lpstrDefExt = "bmp"; ofn.nMaxFileTitle = 64; ofn.lpstrFileTitle = FileTitle; ofn.lpstrTitle = "ファイルを開く!"; if (GetOpenFileName(&ofn)) { show = 1; InvalidateRect(hWnd, NULL, TRUE); } return; } を呼び出してファイルを開くためのダイアログボックスを表示しようとしてのですが無応答で何も表示してくれません コンパイラは無償Borland C++5.5です 何が悪いか教えてください

  • Active Basic ファイルの複数選択

    AB 4.23.00を使っています。 ファイルの複数選択し、それぞれのファイルパスと名前をリストボックスに送信したいのですが、NULL文字の検索のやり方がわかりません。 すみませんが、どのようにすればよいのかをご教授ください。 コードは、 Dim ofn As OPENFILENAME Dim FilePath[MAX_PATH-1] As Byte 'ファイル名を取得 ofn.lStructSize=Len(ofn) ofn.hwndOwner=hMainWnd ofn.lpstrFilter=Ex"音楽 ファイル(wav;mp3;mid;midi)\0*.wav;*.mp3;*.mid;*.midi\0\0" ofn.nFilterIndex=0 ofn.lpstrFile=FilePath ofn.nMaxFile=MAX_PATH ofn.lpstrTitle="Soundファイルを開く" ofn.Flags=OFN_ALLOWMULTISELECT or OFN_HIDEREADONLY or OFN_LONGNAMES or OFN_EXPLORER If GetOpenFileName(ofn)=0 Then Exit Sub End If を使っています。 ここから、1つずつならファイル名とファイルパスは取得できるのですが、複数選択の場合のやり方がわかりません。 すみませんが、お願いします。

  • エクセル VBAでコンピューター名を所得・・・

    いつも皆様には大変お世話になっております。 今回の質問は コンピューター名を所得する方法についてなのですが、 Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Public Sub コンピュータ名() Dim nBuffer As String * 16 Call GetComputerName(nBuffer, Len(nBuffer)) MsgBox Left(nBuffer, InStr(nBuffer, vbNullChar) - 1) End Sub 通常時はこれで動くのですが、 やりたいのが ボタン→ユーザーフォームコマンドボタンの流れで作りたいのです。 Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" _ (ByVal lpBuffer As String, nSize As Long) As Long Private Sub CommandButton1_Click() Dim nBuffer As String * 16 Call GetComputerName(nBuffer, Len(nBuffer)) MsgBox Left(nBuffer, InStr(nBuffer, vbNullChar) - 1) End Sub と作ると、上の2行で止まってしまいます。 多分上の2行をどこか別のところに書けばいいのかな?と思うのですが、どこに書いてもエラー出まくりです。 どなたか私に愛の手をお願い致します。

  • 現在ファイルを開いている全てのユーザー名を取得

    パソコン1に入っているアクセスファイル(accdb)に パソコン1とパソコン2で同時に開いています。 共有している状態です。 その際、現在ファイルを開いている全てのユーザー名を取得したいのですが http://okwave.jp/qa/q3589812.html を参考に ' // 標準モジュール Private Declare Function GetUserName Lib "ADVAPI32.dll" Alias "GetUserNameA" ( _     ByVal lpBuffer As String, _     ByRef nSize As Long _ ) As Long Private Const MAX_PATH As Long = 256 ' // Windows のログインユーザー名を取得する Public Function GetLoginUserName() As String   Dim sBuffer As String   sBuffer = String$(MAX_PATH, vbNullChar)   If CBool(GetUserName(sBuffer, MAX_PATH) > 0) Then     GetLoginUserName = Left$(sBuffer, InStr(sBuffer, vbNullChar) - 1)   End If End Function Sub 使い方サンプル()   Dim sUserName As String      sUserName = GetLoginUserName()   MsgBox "USER: " & sUserName, vbInformation    End Sub を実行してみたのですが、それぞれ自分のユーザー名しか取得されません。 http://billyboy.blog81.fc2.com/blog-entry-157.html の Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" _ (ByVal lpBuffer As String, _ nSize As Long) As Long Function GetLoginName() Dim strBuffer As String * 255, retValue As Long retValue = GetUserName(strBuffer, 255) GetLoginName = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1) End Function Sub sample() MsgBox GetLoginName() End Sub を実行しても同じです。 http://www.tsware.jp/tips/tips_013.htm も自分のユーザー名しか取得できません。 どれも標準モジュールに貼り付けました。 現在ファイルを開いているユーザー名を取得するにはどうすればいいでしょうか?

  • ウィンドウに表示されないのはなぜ?

    ウィンドウの右クリックで、 ファイル名を読み込み、ウィンドウ上に表示させたいのですが、 うまくいかないです。どうしてでしょう。 ちなみに、タイトルバーには、表示されます。 宜しくお願い致します。 case WM_RBUTTONUP: if ( ofn.lStructSize == 0 ){ ofn.lStructSize = sizeof( OPENFILENAME ); ofn.hwndOwner = hWnd; ofn.lpstrFilter = TEXT("Text files {*.txt}\0*.txt\0") TEXT("HTML files {*.htm}\0*.htm;*.html\0") TEXT("All files {*.*}\0*.*\0\0"); ofn.lpstrCustomFilter = strCustom; ofn.nMaxCustFilter = sizeof( strCustom ); ofn.nFilterIndex = 0; ofn.lpstrFile = strFile; ofn.nMaxFile = sizeof( strFile ); ofn.Flags = OFN_FILEMUSTEXIST; } if ( GetOpenFileName(&ofn) ){ SelectObject( hdc, hFont ); SetBkColor( hdc, RGB(255,255,255) ); TextOut( hdc, 200, 410, strFile, lstrlen(strFile) ); SetWindowText( hWnd, strFile ); } else{ MessageBox( hWnd, TEXT("キャンセルされました。"), TEXT("確認"), MB_OK ); } return 0;

  • エクセルのマクロで教えて下さい

    エクセルのマクロでプリンタ名を取得しています エクセルの32ビット版と64ビット版で共用できるように下記の記述をしたのですが 32ビット版は問題ないのですが、64版ではエラーが発生します エラーの原因がわかれば教えて下さい Option Explicit 'このEnumprintersとMoveMemoryがWin32 API の宣言です。 #If VBA7 And Win64 Then Type PRINTER_INFO_1 flags As LongPtr pPDescription As LongPtr pName As LongPtr pComment As LongPtr #Else Type PRINTER_INFO_1 flags As Long pPDescription As Long pName As Long pComment As Long End Type #End If Private Const PRINTER_ENUM_LOCAL = &H2 #If VBA7 And Win64 Then Private Declare PtrSafe Function Enumprinters Lib "WINSPOOL.DRV" Alias "EnumPrintersA" _ (ByVal flags As LongPtr, ByVal Name As String, ByVal Level As LongPtr, pPrinterEnum As Any, _ ByVal cdBuf As LongPtr, pcbNeeded As LongPtr, pcReturned As LongPtr) As Long Private Declare PtrSafe Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" _ (Dest As Any, Source As Any, ByVal length&) #Else Private Declare Function Enumprinters Lib "WINSPOOL.DRV" Alias "EnumPrintersA" _ (ByVal flags As Long, ByVal Name As String, ByVal Level As Long, pPrinterEnum As Any, _ ByVal cdBuf As Long, pcbNeeded As Long, pcReturned As Long) As Long Private Declare Sub MoveMemory Lib "KERNEL32" Alias "RtlMoveMemory" _ (Dest As Any, Source As Any, ByVal length&) #End If

  • GetOpenFilename(MultiSelect)が配列を返さない

    下記のIf行で配列を返したいのですが、うまくいかずに Stopステートメントで止まってしまいます(デバッグ用です)。 特に、下記コードを記述したブックを非表示にし、 ダイアログ内でファイルの場所を変更した時に 配列を返さないようです。 どなたか解決方法をご存知の方がいらっしゃったら、 よろしくお願いいたします。 なお、WindowsXP Pro. SP2、Excel2003 SP2です。 Dim OpenFileName As Variant OpenFileName = Application.GetOpenFilename _ (FileFilter:="dsc,*.dsc,すべてのファイル,*.*", MultiSelect:=True) If IsArray(OpenFileName) Then ・・・コード・・・ ElseIf OpenFileName <> False Then Stop End If

専門家に質問してみよう