コモンダイアログで複数のファイルを開く

2023/07/26 20:24

このQ&Aのポイント

コモンダイアログを使って複数のファイルパスを取得するプログラムを作りましたが、多くのファイルを選択すると警告メッセージが表示されます。ファイル名の文字数に関係があるのか分かりません。
実行すると「ファイルを開く」という警告メッセージが表示されます。ファイル名の文字数が短いと多くのファイルを選択できるようです。
コードには問題がないと思いますが、使用しているバージョンによってSplitが使えないため、プロシージャを使用してファイルパスを取得しています。

ベストアンサー

コモンダイアログで複数のファイルを開く

2002/06/11 00:36

このサイトでの質問No.222750 http://www.okweb.ne.jp/kotaeru.php3?q=222750 を読んで、コモンダイアログを使って複数のファイルパスを取得するプログラムを作りました。ところが実行するとある程度の数のファイルなら問題はないのですが多いと、タイトル：「ファイルを開く」内容：「c:\（ここにパスが入ります）\ 上記のファイル名は無効です」という警告メッセージが出ます。それらのファイルも数を加減して開けばメッセージは出ないので、ファイル名に問題があるとは思えません。それぞれのファイル名が短いと、多くのファイルを選択できることから文字数に関係があると思うのですが、よく分かりません。コードはNo.222750の#1の回答とほとんど同じです。但し使っているver5ではSplitが使えないためにプロシージャを使って以下のように書き換えました。ここに問題はないと思うのですがよろしくお願いします。 'Splitを用いている文の書き換え Call SplitD(CommonDialog1.Filename, vbNullChar, valWork()) ' Private Sub SplitD(Filename As String, Serch As String, strData() As Variant) Dim t As Integer Dim s As Long　　'検索開始位置 Dim e As Long　　'検索文字位置 s = 1 Do e = InStr(s, Filename, Serch) If e = 0 Then: e = Len(Filename) + 1 ReDim Preserve strData(t) strData(t) = Mid(Filename, s, e - s) t = t + 1 s = e + 1 Loop Until e = Len(Filename) + 1 End Sub

Ryuku
お礼率68% (81/119)

Visual Basic
回答数1
ありがとう数1

みんなの回答 （1）
専門家の回答

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

ベストアンサー

Vargas
ベストアンサー率45% (9/20)

2002/06/11 12:14 回答No.1

コモンダイアログコントロールのプロパティである MaxFileSizeは設定しましたか？デフォルト値は256byteなので、それを超える選択されたファイルパス名＋ＮＵＬＬ値であるとエラーになります。 MaxFileSizeプロパティの最大値は32kですので、 CommonDialog1.MaxFileSize = 32767 を設定してみてはどうでしょうか。

質問者

お礼 2002/06/12 01:02

そういったプロパティがあったんですか。サイズの関係だろうと思って、変数がオーバーフローしないようにデータ型を変えてみたりしたのですがそれではなかったんですね。助かりました。

関連するQ&A

VBAで複数のエクセルファイルを自動圧縮
VBAで複数のエクセルファイルを自動圧縮お世話になります。以下サイトなどを参考にVBAでエクセルファイルの圧縮をさせようとしています。ダイアログで圧縮したいファイルを指定して圧縮するところまではできました。 http://oshiete.hmv.co.jp/qa5155002.html ■やりたいこと特定のフォルダにある複数のファイルを個別に圧縮して、それぞれzipファイルとしたい。圧縮するファイルを指定するダイアログは出さずに、自動化したい。 ■VBAの記述 Dim Filename As String Dim strArchiveName As String Dim strCommand As String Dim RC As Long Dim hWnd As Long Dim strOutPut As String * 512 Dim lngSize As Long Dim strPassWord As String strPassWord = "pass" 'ハンドル取得 hWnd = FindWindow("XLMANI", Application.Caption) '★ファイル名取得★ Filename = Application.GetOpenFilename("*.xls(*.xls),*.xls") If Filename = "False" Then Exit Sub Filename = Mid$(Filename, InStrRev(Filename, "\") + 1) strArchiveName = Mid$(Filename, InStrRev(Filename, "\") + 1, InStrRev(Filename, ".") - InStrRev(Filename, "\") - 1) & & ".zip" strCommand = "-uP " & strPassWord & " " & strArchiveName & " " & Filename lngSize = Len(strOutPut) RC = Zip(hWnd, strCommand, strOutPut, lngSize) ■質問　ファイル名を毎回変えて繰り返し処理すればいいと考えてますが、　圧縮するファイルを指定するダイアログを消すことができません。。。　ファイル名を以下のように直接指定しましたが、以下エラーが出てしまいます。　VBAで取得したファイル名で圧縮するような記述の仕方があればご教示いただけると助かります！ '★ファイル名取得★ Filename = Application.GetOpenFilename("*.xls(*.xls),*.xls") If Filename = "False" Then Exit Sub 　 ↓以下に変更したがエラー　Filename = "C:\" & "test.xls" ←とりあえずファイル名を固定で指定したつもり。。　●イミディエイトに表示されるエラー　　zip warning: name not matched: test.xls 　　zip warning: test.zip not found or empty
- ベストアンサー
- Visual Basic
Active Basic　フォルダの絶対パスの取得
ファイルまでの絶対パスの取得のように、自分のフォルダまでのパスを取得するにはどうしたらいいのでしょうか？ D:\aaaa\bbbb\cccc\dddd\abcd.exe があって、 D:\aaaa\bbbb\cccc\dddd\ を取得したいのですが・・・実験してみたのですが、上手くいきませんでした。すみませんが、やり方をご教授ください。お願いします。 ↓頑張った証 '自分自身のファイルパスを取得する Dim path[MAX_PATH] As Byte Dim FileName As BytePtr Dim MaxFilePath As Long Dim MyFileName As Long Dim AllByte As Long Dim MidAns As String GetModuleFileName(NULL,path,MAX_PATH) 'ファイルパスからファイル名を抜き出し、その大きさを取得して、引く FileName=malloc(Len(path)+1) GetFileTitle(path,FileName,Len(path)+1) MaxFilePath=Len(path) MyFileName=Len(FileName)+1 AllByte=MaxFilePath-MyFileName 'フォルダまでのパスを抜き出す MidAns=Mid$(path,1,54) free(FileName)
- ベストアンサー
- その他（プログラミング・開発）
エクセルファイル　行列入れ替えたもの同時作成VBA
あるxmlファイルを一旦テキストファイルにしてそこから数値をエクセルファイルに移行してひとつはM.xlsxとしそれに続いて行列を入れ替えたエクセルファイルR.xlsxを作りたいのですが M.xlsx　R.xlsxのそれぞれを作るコードを単純に　合体させただけではどうも　できません M.xlsxだけ　また　R.xlsxだけの作成するコードは　出来たのですがそれぞれ別のマクロとして実行することになりますひとつのマクロでM.xlsx　R.xlsx同時に作成するVBAコードは可能でしょうか宜しくお願い致しますちなみに該当コードを単純化して合体したのが以下のものです win10 office10 Sub 783縦() Dim FileName As Variant ChDir "\\DESKTOP-O5\f" FileName = Application.GetOpenFilename(FileFilter:="xmlファイル,*.xml") If FileName = False Then MsgBox "キャンセルされました" Exit Sub End If FileCopy FileName, Left(FileName, InStrRev(FileName, "\")) & "テキスト.txt" Const MyFile = "\\DESKTOP-O5\f\テキスト.txt" Const Key1 = "<Name>" Const Key2 = "</Name>" Const Key3 = "<NameKana>" Const Key4 = "</NameKana>" Const PutBokName = "M.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(1, 2).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(2, 1).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With Const PutBokName = "R.xlsx" Dim buf As String Dim Len1 As Long Dim Len2 As Long Dim Pos1 As Long Dim Pos2 As Long Dim Len3 As Long Dim Len4 As Long Dim Pos3 As Long Dim Pos4 As Long Dim PutBook As Workbook With CreateObject("ADODB.Stream") .Charset = "UTF-8" .Open .LoadFromFile MyFile buf = .ReadText .Close End With Len1 = Len(Key1) Len2 = Len(Key2) Pos1 = InStr(buf, Key1) Pos2 = InStr(buf, Key2) Len3 = Len(Key3) Len4 = Len(Key4) Pos3 = InStr(buf, Key3) Pos4 = InStr(buf, Key4) Set PutBook = Workbooks.Add With PutBook.Sheets(1) .Cells(1, 1).Value = "氏名" .Cells(2, 1).Value = Mid(buf, Pos1 + Len1, Pos2 - (Pos1 + Len1)) .Cells(1, 2).Value = "氏名カナ" .Cells(2, 2).Value = Mid(buf, Pos3 + Len3, Pos4 - (Pos3 + Len3)) 'クリップボードをクリア Application.CutCopyMode = False PutBook.SaveAs ThisWorkbook.Path & "\" & PutBokName End With End Sub -------------------------------
- 締切済み
- その他（プログラミング・開発）
ユーザー構造体
以下のようなことはできないのでしょうか? Type TEST strData1 as String * 1 strData2 as String * 1 strData3 as String * 2 End Type Function BATCH() Dim Wk1 as String Dim Wk2 as TEST Wk1="TEST" Wk2=Wk1 * Wk2.strData1にT * Wk2.strData1にE * Wk2.strData1にSTが代入されるようなイメージ * 一般的はWk2.strData1=Mid(Wk1,1,1)とかですよね。 End Function どなたかわかる方ご教授してください。
- ベストアンサー
- Visual Basic
vba　ファイルの移動について
フォルダAの中にあるたくさんのpdfファイルの中から、ファイル名の頭文字３つがE列に記載した「aaa」だったらフォルダBに移動させるという内容にしたいです。ネット検索などで、近いものを作成しましたが（下に貼り付け）、下から４行目、「fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName」で「実行時エラー'53'　　ファイルが見つかりません。」　とエラーが出てしまいます。どの様に書き直せばよいのでしょうか？どなたかご存じでしたら、ぜひお教え下さい。よろしくお願いします。エクセル2010を使用しています。 Sub CheckAndMoveFiles() Dim FolderA As String Dim FolderB As String FolderA = Range("D1").Value FolderB = Range("B2").Value Dim fso As Object Set fso = CreateObject("Scripting.FileSystemObject") Dim ws As Worksheet Set ws = ActiveSheet Dim lastRow As Long lastRow = ws.Range("E" & Rows.Count).End(xlUp).Row Dim r As Long Dim fileName As String For r = 1 To lastRow If ws.Cells(r, "E").Value <> "" Then fileName = ws.Cells(r, "E").Value dFileName = Dir(FolderA & "\" & Left(fileName, 3) & "*.pdf") Do While dFileName <> "" dFileName = Dir() Loop fso.moveFile FolderA & "\" & fileName, FolderB & "\" & fileName　'ここでストップ End If Next End Sub
- ベストアンサー
- Excel（エクセル）
VBAを使ってファイルを圧縮したい
こんばんは。他の方の質問ですが http://oshiete1.goo.ne.jp/qa2405614.html を参考にＶＢＡでエクセルファイルの圧縮に挑戦しています。しかしうまくいきません。なのでご教授お願いします。エクセルの標準モジュールに下記のコードを載せました。 //////////////////////////////////////////////////////////////////////// 'Option Explicit Private Declare Function Zip Lib "Zip32j" (ByVal hWnd As Integer, ByVal szCmdLine As String, ByVal szOutPut As String, ByVal dwsize As Integer) As Integer Private Declare Function FindWindow Lib "USER32.dll" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long Sub testZip() 'Zip32 による圧縮 Dim Filename As String Dim strArchiveName As String Dim strCommand As String Dim RC As Long Dim hWnd As Long Dim strOutPut As String * 512 Dim lngSize As Long 'ハンドル取得 hWnd = FindWindow("XLMANI", Application.Caption) 'ファイル名取得 Filename = myDeskTopPath & "\Book1.xls" If Filename = "False" Then Exit Sub Filename = Mid$(Filename, InStrRev(Filename, "\") + 1) strArchiveName = Mid$(Filename, InStrRev(Filename, "\") + 1, InStrRev(Filename, ".") - InStrRev(Filename, "\") - 1) & ".zip" strCommand = "-u " & strArchiveName & " " & Filename lngSize = Len(strOutPut) RC = Zip(hWnd, strCommand, strOutPut, lngSize) 'Debug.Print strOutPut End Sub Function myDeskTopPath() ' 実行時のデスクトップパス取得 Dim MyWSH As Object Set MyWSH = CreateObject("WScript.Shell") myDeskTopPath = MyWSH.SpecialFolders("Desktop") Set MyWSH = Nothing End Function //////////////////////////////////////////////////////////////////////// そして「Zip32j 」がないので http://www.vector.co.jp/soft/win95/util/se062163.html からダウンロードしました。しかし、「 RC = Zip(hWnd, strCommand, strOutPut, lngSize)」の部分で、「ファイルが見つかりません。 (Error 53)」になります。ダウンロードした「zip3j037」はフォルダごとデスクトップに置いています。ただこれをダウンロードしただけではダメなのでしょうか？エラーの原因がわかりません。よろしくお願いします。
- ベストアンサー
- オフィス系ソフト
日本語混じりのファイルをランダムアクセスで読みこむ場合
ファイルを１０２４バイトずつ読みこみ、その内容をソケットでホストへ送るというアプリがあります。ファイルを「１０２４バイト読んで→送信」を繰り返すのですが、ファイルを読みこむところ（Get)で日本語が混じったときにエラーを生じます。「レコード長が一致しません」というエラーメッセージです。日本語がはいる桁数だけバイト数は減るためだと思いますが、ランダムアクセスで読みこむと場合の記述の仕方で、何とかならないものかと思案しています。どなたかご教授ください。よろしくお願いします。＜プログラム記述例＞　　Dim filenum As Integer 　　Dim filename As String 　　Dim buffer As String * 1024 　　filename = "e:\tmp\file.txt" 　　filenum = FreeFile 　　Open filename For Random Access Read As #filenum Len = 1024 　　Do While Not EOF(filenum) 　　　　Get #filenum, , buffer 　　Loop 　　Close #filenum
- ベストアンサー
- Visual Basic
「mcisendstring」　ＭＩＤＩファイルの演奏時間の取得に関して
「mcisendstring」により、ＷＡＶＥファイルやＭＰ３ファイルでは演奏時間が正確に取得できましたが、ＭＩＤＩファイルでは正確に取得できませんでした。おそらく、ＭＩＤＩ特有のテンポなどの情報が関係しているのだと思いますが、対処方法が思い当たりません。どなたか、教えて下さい。（因みに　ＶＢ６＋ＷＩＮＤＯＵＷＳ９８ＳＥの環境です。）以下は、私のプログラム事例です。 '■GetLength '■機能: ファイルの長さを秒単位で返す。 '■引数: FileName 対象のファイル名 Private Function GetLength(FileName As String) As Double Dim RetBuffer As String * 20 Dim MCICommandString As String MCICommandString = "status """ & FileName & """ length" Call mciSendString("open """ & FileName & """", "", 0, 0) Call mciSendString(MCICommandString, RetBuffer, Len(RetBuffer), 0) Call mciSendString("close """ & FileName & """", "", 0, 0) GetLength = Val(RetBuffer) / 1000 End Function
- ベストアンサー
- Visual Basic
EXCEL2007のVBAを使って、テキストファイルを読み込んで別のテ
EXCEL2007のVBAを使って、テキストファイルを読み込んで別のテキストファイルを作って書き込むというコードを書きましたが、新しく出来たテキストファイルの末尾に、もともとのファイルには無かったスペースが追加されてしまいます。原因と対策を教えて頂きたいです。 ------------------------------------------------------- Dim FileName1 As String Dim FileName2 As String Dim FileNumber1 As Integer Dim FileNumber2 As Integer Dim Data As String FileName1 = Application.GetOpenFilename("Text Files (*.txt), *.txt") FileName2 = Application.GetSaveAsFilename(, "Text Files (*.txt), *.txt") Data = Space(FileLen(FileName1)) FileNumber1 = FreeFile Open FileName1 For Binary As #FileNumber1 Get #FileNumber1, , Data Close #FileNumber1 'この間に"Data"内容を処理するコードを入れる予定 FileNumber2 = FreeFile Open FileName2 For Binary As #FileNumber2 Put #FileNumber2, , Data Close #FileNumber2 ------------------------------------------------------- このコードで1284バイトのテキストを読み込ませると末尾にスペースが追加されて1918バイトになってしまいました。 "Data"の内容を表示させてもスペースはなく、Len関数で大きさを調べても1284バイトです。
- ベストアンサー
- Visual Basic
フォルダ内の対象となるデータ名の個数
フォルダ内にある任意のデータ名の個数を数えるエクセルのマクロを使って作成したいと思っています任意のデータ名はA1セルに入力されている名前を使おうと思っています以下にワイルドカードを使った場合のコードを貼っておきます。 Sub Sample2() Dim FolderPath As String Dim FileName As String Dim FileInt As Long Dim SetPath As String FolderPath = "C:\Users\ユーザ名\Desktop\データ" 'フォルダのパスを指定する FileName = "*.xlsm" 'ファイル名をワイルドカードと拡張を指定する FileInt = 0 'ファイル数を一度0にする '指定したフォルダパスとファイル名をセットする SetPath = Dir(FolderPath & "\" & FileName) Do While SetPath <> "" 'ファイル名が取得出来なくなるまでループ FileInt = FileInt + 1 SetPath = Dir() Loop MsgBox FileInt End Sub
- 締切済み
- Excel（エクセル）