Excel VBA質問箱 IV

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

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


34432 / 76734 ←次へ | 前へ→

【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
3 hits

【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 お礼

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