Excel VBA質問箱 IV

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

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


6043 / 13645 ツリー ←次へ | 前へ→

【47479】VBAからファイルを開く yhar 07/3/12(月) 9:18 質問[未読]
【47483】Re:VBAからファイルを開く とおりすがり 07/3/12(月) 10:59 発言[未読]
【47485】Re:VBAからファイルを開く yhar 07/3/12(月) 11:22 質問[未読]
【47486】Re:VBAからファイルを開く Jaka 07/3/12(月) 11:31 発言[未読]
【47497】【複数ファイル選択は?】VBAからファイル... yhar 07/3/12(月) 16:22 質問[未読]
【47498】Re:【複数ファイル選択は?】VBAからファイ... ウッシ 07/3/12(月) 16:46 回答[未読]
【47500】Re:VBAからファイルを開く Hirofumi 07/3/12(月) 18:58 回答[未読]
【47503】【Sendkeys?】VBAからファイルを開く yhar 07/3/12(月) 19:42 発言[未読]
【47505】Re:【Sendkeys?】VBAからファイルを開く Hirofumi 07/3/12(月) 20:04 回答[未読]
【47508】IMEを直前で無効に出来れば… yhar 07/3/12(月) 20:17 発言[未読]
【47510】Re:IMEを直前で無効に出来れば… Hirofumi 07/3/12(月) 21:27 発言[未読]
【47512】Re:IMEを直前で無効に出来れば… Hirofumi 07/3/12(月) 22:07 回答[未読]
【47522】皆さんありがとうございました。 yhar 07/3/13(火) 8:33 お礼[未読]

【47479】VBAからファイルを開く
質問  yhar  - 07/3/12(月) 9:18 -

引用なし
パスワード
   いつもお世話になっております。またまた質問ですがよろしくお願いします。
複数の人が作成する日々の報告書を管理者が集計する為のプログラムを作っています。
処理は1日単位でファイル名は特定のフォルダに必ず日付を現す「07-03-11*.xls」と言う名前で保存されていると言うのがルールです。
過去ログなどから、複数のファイルを開く事までは出来そうなのですが、
●特定のフォルダを指定するにはどうしたらよいか?
●「07-03-11*.xls」と言うファイルのみをダイアログに表示させる事は出来ないか?
と言うのが質問の主旨です。

以下は、ここまで作成したプログラムです。何卒ご教示のほどを!

Sub 集計()
'各自が作成した日報の記録ファイルを指定した日付を元に開いて決められた処理をする。

Dim MyDate As String
Dim FileNam As String
Dim FName As Variant
Dim x As Variant

MyDate = InputBox("処理する日付をYYMMDDの形式で入力してください。")
If MyDate = "" Then Exit Sub
If Len(MyDate) <> 6 Then
  MsgBox ("入力形式が間違っています。YYMMDDの形式で入力し直してください。")
  Exit Sub
End If
MyDate = Left(MyDate, 2) & "/" & Mid(MyDate, 3, 2) & "/" & Right(MyDate, 2)
If IsDate(MyDate) = False Then
  MsgBox ("入力は日付のデータです。YYMMDDの形式で入力し直してください。")
  Exit Sub
End If

MyDate = Left(MyDate, 2) & "-" & Mid(MyDate, 4, 2) & "-" & Right(MyDate, 2)
FileNam = MyDate & "*.xls"

'SendKeys "07-03-11*.xls"
FName = Application.GetOpenFilename(FileFilter:="xls ファイル (*.xls), *.xls", MultiSelect:=True)

'MsgBox (VarType(FName))    'VarType(FName)の戻り値確認用のデバグ道具
'GoTo 正常処理

If VarType(FName) = 8204 Then GoTo 正常処理   'ファイルが選択されている時の関数 VarType(FName)の戻り値は「8204」となるので…
If FName = False Then
  MsgBox ("ファイルが選択されなかったので、何もしません。")
  Exit Sub
End If

正常処理:
For Each x In FName
  MsgBox (x)
  Workbooks.Open Filename:=x
  'ここに一連の処理プログラムを挿入する。
Next
End Sub

【47483】Re:VBAからファイルを開く
発言  とおりすがり  - 07/3/12(月) 10:59 -

引用なし
パスワード
   >●特定のフォルダを指定するにはどうしたらよいか?

ChDir "特定のフォルダ"
変数 = application.GetOpenFilename …

でいいのかな?

>●「07-03-11*.xls」と言うファイルのみをダイアログに表示させる事は出来

無理な希ガス。
選んだものが「07-03-11」で始まっていなければもう一度選ぶとかはどうでしょう?

【47485】Re:VBAからファイルを開く
質問  yhar  - 07/3/12(月) 11:22 -

引用なし
パスワード
   とおりすがりさん、早々のコメントありがとうございます。

▼とおりすがり さん:
>>●特定のフォルダを指定するにはどうしたらよいか?
>
>ChDir "特定のフォルダ"
>変数 = application.GetOpenFilename …

ChDirの後は、文字列変数で指定することも出来ますか?

>>●「07-03-11*.xls」と言うファイルのみをダイアログに表示させる事は出来
>
>無理な希ガス。
>選んだものが「07-03-11」で始まっていなければもう一度選ぶとかはどうでしょう?

最悪は人手に頼る腹でいますが、人は間違いをするのが常ですから…

【47486】Re:VBAからファイルを開く
発言  Jaka  - 07/3/12(月) 11:31 -

引用なし
パスワード
   ▼yhar さん:
>●特定のフォルダを指定するにはどうしたらよいか?
getopenで検索すると見つかると思います。
H T T P ://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=23509;id=excel
                             ↑
                   下の記事番号に23509を打ち込んでも良いです。

>●「07-03-11*.xls」と言うファイルのみをダイアログに表示させる事は出来ないか?
目安箱の
【99】GetOpenFileNameでブック名もワイルドカードを使いたい

URLもどき
H T T P ://www.vbalab.net/vbaqa/c-board.cgi?cmd=one;no=99;id=FAQ
 ↑
全角だから使うときは半角英数字に直してください。

【47497】【複数ファイル選択は?】VBAからファイ...
質問  yhar  - 07/3/12(月) 16:22 -

引用なし
パスワード
   レスが少々遅くなりました。
まず、「特定のディレクトリ」については解決です。

もう1点の方は教えて頂いたコードで思った通りのダイアログを表示させる事は出来ましたが、
●複数のファイルを同時に選択できない(選択できればプログラムで順に処理したい)
と言うことが分かりました。何度も申し訳ありませんが、あと一押しご教示お願いします。

▼Jaka さん:
>>●「07-03-11*.xls」と言うファイルのみをダイアログに表示させる事は出来ないか?
>目安箱の
>【99】GetOpenFileNameでブック名もワイルドカードを使いたい
>

【47498】Re:【複数ファイル選択は?】VBAからファ...
回答  ウッシ  - 07/3/12(月) 16:46 -

引用なし
パスワード
   こんにちは

>MultiSelect:=True
でしょうか?

Sub test()
  Dim v As Variant
  Dim i As Long
  v = Application.GetOpenFilename( _
            filefilter:="Excelファイル (*.xls), *.xls", _
            Title:="エクセルを選択してください。", _
            Buttontext:="ボタン", _
            MultiSelect:=True)
  If VarType(v) = vbBoolean Then Exit Sub
  For i = LBound(v) To UBound(v)
    Debug.Print v(i)
  Next
End Sub

【47500】Re:VBAからファイルを開く
回答  Hirofumi  - 07/3/12(月) 18:58 -

引用なし
パスワード
   こんなかな?

以下を全て標準モジュールに記述してください

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim vntDate As Variant
  Dim strPath As String
  Dim vntFileNames As Variant
  Dim strProm As String
  
  strProm = "処理する日付を入力してください。"
  Do
    vntDate = InputBox(strProm, "日付入力", Date)
    If IsDate(vntDate) Then
      Exit Do
    Else
      strProm = "日付が間違っていますので、再度入力してください。"
    End If
  Loop Until vntDate = ""
  
  'キャンセルボタンが押された時
  If vntDate = "" Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If
  
  'ファイルのBaseNameを作成
  vntFileNames = Format(DateValue(vntDate), "yy-mm-dd") & "*"
  'ダイアログを開くフォルダを指定
  strPath = ThisWorkbook.Path
  
  'ダイアログを開く
  If Not GetReadFile(vntFileNames, strPath, True) Then
    strProm = "ファイル選択がされませんのでマクロを終了します"
    GoTo Wayout
  End If
  
  '画面更新を停止
'  Application.ScreenUpdating = False
  
  For i = 1 To UBound(vntFileNames)
    MsgBox vntFileNames(i) & "を開きます"
'    Workbooks.Open FileName:=vntFileNames(i)
    'ここに一連の処理プログラムを挿入する。
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  MsgBox strProm, vbInformation
  
End Sub

Private Function GetReadFile(vntFileNames As Variant, _
            Optional strFilePath As String, _
            Optional blnMultiSel As Boolean _
                    = False) As Boolean

  Dim strFilter As String
  
  'フィルタ文字列を作成
  strFilter = "Excel File (*.xls),*.xls"
  '読み込むファイルの有るフォルダを指定
  If strFilePath <> "" Then
    'ファイルを開くダイアログ表示ホルダに移動
    ChDrive Left(strFilePath, 1)
    ChDir strFilePath
  End If
  'もし、ディフォルトのファイル名が有る場合
  If vntFileNames <> "" Then
    SendKeys vntFileNames & "{TAB}", False
  End If
  '「ファイルを開く」ダイアログを表示
  vntFileNames _
      = Application.GetOpenFilename(strFilter, 1, , , blnMultiSel)
  If VarType(vntFileNames) = vbBoolean Then
    Exit Function
  End If
  
  GetReadFile = True
  
End Function

【47503】【Sendkeys?】VBAからファイルを開く
発言  yhar  - 07/3/12(月) 19:42 -

引用なし
パスワード
   Hirofumiさん、別案ありがとうございます。
早々に試して見ましたが、開いたダイアログのファイル名のところが
「07−03−12*」と全角で入力されています。

実は皆さんのコメントからヒントを得てSendkeysを試して見たのです
がどんな文字列を入れても全て全角のデータが入ってしまいます。
どう考えても怪しいです。ここが解決すると何とかなりそうな気もし
ているのですが…

OSはXPのSP2、エクセルは2002のSP3と言う環境です。

【47505】Re:【Sendkeys?】VBAからファイルを開く
回答  Hirofumi  - 07/3/12(月) 20:04 -

引用なし
パスワード
   ▼yhar さん:
>Hirofumiさん、別案ありがとうございます。
>早々に試して見ましたが、開いたダイアログのファイル名のところが
>「07−03−12*」と全角で入力されています。
>
>実は皆さんのコメントからヒントを得てSendkeysを試して見たのです
>がどんな文字列を入れても全て全角のデータが入ってしまいます。
>どう考えても怪しいです。ここが解決すると何とかなりそうな気もし
>ているのですが…
>
>OSはXPのSP2、エクセルは2002のSP3と言う環境です。

うーむ!!
原因が解りません?
一応、Win98のExcel2000と97、WinXPのExcel2003でTestして
上手く動いているのですが?

【47508】IMEを直前で無効に出来れば…
発言  yhar  - 07/3/12(月) 20:17 -

引用なし
パスワード
   皆さんのお陰であと一歩まで来ました。
プログラムを走らせる際にIMEを有効にしたり、無効にしたりしてみましたが
IMEが有効 → 全角でデータを送る
IMEが無効 → 半角でデータを送る
と言うことが分かりました。
Sendkeys の直前でIMEを無効に出来れば全てが解決する目処が立っています。

よろしくお願いします。

【47510】Re:IMEを直前で無効に出来れば…
発言  Hirofumi  - 07/3/12(月) 21:27 -

引用なし
パスワード
   ここいら辺が参考に成るのでは?

HTTpp://www.officetanaka.net/excel/vba/tips/tips16.htm

【47512】Re:IMEを直前で無効に出来れば…
回答  Hirofumi  - 07/3/12(月) 22:07 -

引用なし
パスワード
   別案として
「ファイルを開く」ダイアログを出さずに、
指定フォルダの「07-03-11*.xls」形式のBookを全てOpenする方法?

Option Explicit

Public Sub Sample2()

  Dim i As Long
  Dim vntDate As Variant
  Dim strPath As String
  Dim vntFileNames As Variant
  Dim strProm As String
  
  strProm = "処理する日付を入力してください。"
  Do
    vntDate = InputBox(strProm, "日付入力", Date)
    If IsDate(vntDate) Then
      Exit Do
    Else
      strProm = "日付が間違っていますので、再度入力してください。"
    End If
  Loop Until vntDate = ""
  
  'キャンセルボタンが押された時
  If vntDate = "" Then
    strProm = "マクロがキャンセルされました"
    GoTo Wayout
  End If
  
  'ファイルのBaseNameを作成
  vntDate = Format(DateValue(vntDate), "yy-mm-dd") & ".*"
  'ダイアログを開くフォルダを指定(最後に¥を付け無い様にする事)
  strPath = ThisWorkbook.Path
  
  'フォルダから指定ファイルを探索
  If Not GetFilesList(vntFileNames, strPath, CStr(vntDate), "xls") Then
    strProm = "指定ファイルが存在しませんのでマクロを終了します"
    GoTo Wayout
  End If
  
  '画面更新を停止
'  Application.ScreenUpdating = False
  
  For i = 1 To UBound(vntFileNames)
    MsgBox vntFileNames(i) & "を開きます"
'    Workbooks.Open FileName:=vntFileNames(i)
    'ここに一連の処理プログラムを挿入する。
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  '画面更新を再開
  Application.ScreenUpdating = True
  
  MsgBox strProm, vbInformation
  
End Sub

Private Function GetFilesList(vntFileNames As Variant, _
              strFilePath As String, _
              Optional strNamePattan As String = ".*", _
              Optional strExtePattan As String = ".*") As Boolean

  Dim i As Long
  Dim objFiles As Object
  Dim objFile As Object
  Dim regExten As Object
  Dim regName As Object
  Dim vntRead() As Variant
  Dim strName As String
  Dim objFSO As Object

  'FSOのオブジェクトを取得
  Set objFSO = CreateObject("Scripting.FileSystemObject")
 
  'フォルダの存在確認
  If Not objFSO.FolderExists(strFilePath) Then
    GoTo Wayout
  End If

  'regExtenpのオブジェクトを取得(正規表現を作成)
  Set regExten = CreateObject("VBScript.RegExp")
  With regExten
    'パターンを設定
    .Pattern = strExtePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With
  Set regName = CreateObject("VBScript.RegExp")
  With regName
    'パターンを設定
    .Pattern = strNamePattan
    '大文字と小文字を区別しないように設定
    .IgnoreCase = True
  End With

  'フォルダオブジェクトを取得
  Set objFiles = objFSO.GetFolder(strFilePath).Files

  'ファイルの数が0でなければ
  If objFiles.Count <> 0 Then
    For Each objFile In objFiles
      With objFile
        strName = .Path
        '検索をテスト
        If regExten.test(objFSO.GetExtensionName(strName)) Then
          If regName.test(objFSO.GetBaseName(strName)) Then
            i = i + 1
            ReDim Preserve vntRead(1 To i)
            vntRead(i) = strName
          End If
        End If
      End With
    Next objFile
  End If

  Set regExten = Nothing
  Set regName = Nothing

  If i <> 0 Then
    vntFileNames = vntRead
    GetFilesList = True
  End If

Wayout:

  'フォルダオブジェクトを破棄
  Set objFiles = Nothing
  Set objFile = Nothing
  Set objFSO = Nothing

End Function

【47522】皆さんありがとうございました。
お礼  yhar  - 07/3/13(火) 8:33 -

引用なし
パスワード
   とおりすがりさん、Jakaさん、ウッシさん、Hirofumiさん
数々のアドバイス・ご提案ありがとうございました。最後に残ったIMEの制御については当面、人の判断で対応することにしますが、Hirofumiさんの情報ほかを参考にすれば何とかなりそうです。
皆さんのお陰でほぼ思った通りの動作をするコードが書けました。本当にありがとうございます。

せっかくなので少しでもお返しをしておきたく、下記ご参考までの情報です。
1.SendKeysを使ってダイアログに文字列を送る場合は、
 SendKeys "abcd" & "{TAB}"
 と連続して送るより、データとタブを2回に分けて送るほうが動作が確実になる。

2.SendKeysを使うときにIME(日本語入力)が有効になっていると半角から全角に
 変換された文字列が送られることがある。

3.フォームやセル以外でIMEを制御したい場合はAPIを使う必要がある様子
 Hirofumiさんの紹介以外にも下記を見つけました。
http://support.microsoft.com/kb/402484/ja

また、次の機会にもよろしくお願いします。

6043 / 13645 ツリー ←次へ | 前へ→
ページ:  ┃  記事番号:
2610219
(SS)C-BOARD v3.8 is Free