Excel VBA質問箱 IV

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

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


48510 / 76732 ←次へ | 前へ→

【33157】Re:外部ファイルの条件選択について
回答  Hirofumi  - 06/1/3(火) 19:52 -

引用なし
パスワード
   かみちゃんさんと同じ様な物ですが?
「Private Function GetFilesList」が指定フォルダの
「yymmdd.txt」形式のファイル名を配列で返してきます

Option Explicit

Public Sub Sample()

  Dim i As Long
  Dim rngResult As Range
  Dim vntFileNames As Variant
  Dim strPath As String
  Dim vntDate As Variant
  Dim strProm As String
  
  'Listの左上隅セル位置を基準として設定(列見出しの最左セル位置)
  Set rngResult = ActiveSheet.Cells(3, "B")
  vntDate = rngResult.Value
  
  'フォルダ名を指定
  strPath = "C:\list"

  '読み込むファイル名を取得(指定フォルダから取得)
  If Not GetFilesList(vntFileNames, strPath, vntDate) Then
    GoTo Wayout
  End If
    
  For i = 1 To UBound(vntFileNames, 1)
    rngResult.Offset(i + 4).Value = vntFileNames(i)
  Next i
  
  strProm = "処理が完了しました"
  
Wayout:
  
  Set rngResult = Nothing
  
  MsgBox strProm, vbInformation
  
End Sub

Private Function GetFilesList(vntFileNames As Variant, _
              strFilePath As String, _
              vntMark As Variant) As Boolean
  
  Dim i As Long
  Dim vntRead() As Variant
  Dim strName As String
  Dim objFso As Object
  Dim lngPos As Long
  Dim vntStart As Variant
  Dim vntFinish As Variant
  Dim lngCount As Long
  
  vntMark = Trim(vntMark)
  lngPos = InStr(1, vntMark, "〜", vbBinaryCompare)
  If lngPos = 0 Then
    GoTo Wayout
  End If
  '開始日付の取得
  vntStart = Left(vntMark, lngPos - 1)
  If IsDate(vntStart) Then
    vntStart = DateValue(vntStart)
  Else
    GoTo Wayout
  End If
  '終了日付の取得
  vntFinish = Mid(vntMark, lngPos + 1)
  If IsDate(vntFinish) Then
    vntFinish = DateValue(vntFinish)
    vntFinish = DateSerial(Year(vntFinish), _
                Month(vntFinish) + 1, 0)
  Else
    GoTo Wayout
  End If
    
  'FSOのオブジェクトを取得
  Set objFso = CreateObject("Scripting.FileSystemObject")
    
  'フォルダの存在確認
  If Not objFso.FolderExists(strFilePath) Then
    GoTo Wayout
  End If
   
  'ファイルの存在確認
  For i = vntStart To vntFinish
    strName = strFilePath & "\" & Format(i, "yymmdd") & ".txt"
    If objFso.FileExists(strName) Then
      lngCount = lngCount + 1
      ReDim Preserve vntRead(1 To lngCount)
      vntRead(lngCount) = strName
    End If
  Next i
  
  'ファイルの数が0でなければ
  If lngCount > 0 Then
    vntFileNames = vntRead
    GetFilesList = True
  End If
      
Wayout:

  'フォルダオブジェクトを破棄
  Set objFso = Nothing
  
End Function
0 hits

【33137】外部ファイルの条件選択について みり 06/1/3(火) 15:59 質問
【33138】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:07 発言
【33139】Re:外部ファイルの条件選択について かみちゃん 06/1/3(火) 16:23 回答
【33157】Re:外部ファイルの条件選択について Hirofumi 06/1/3(火) 19:52 回答
【33174】Re:外部ファイルの条件選択について みり 06/1/4(水) 16:20 質問
【33179】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 17:32 回答
【33184】Re:外部ファイルの条件選択について みり 06/1/4(水) 18:24 質問
【33188】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 18:44 発言
【33196】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:38 回答
【33198】Re:外部ファイルの条件選択について Hirofumi 06/1/4(水) 20:45 発言
【33297】Re:外部ファイルの条件選択について みり 06/1/7(土) 19:00 質問
【33298】Re:外部ファイルの条件選択について Hirofumi 06/1/7(土) 21:52 回答

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