Excel VBA質問箱 IV

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

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


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

【77589】特定ファイルのコピーについて SHO 15/10/30(金) 15:47 質問[未読]
【77590】Re:特定ファイルのコピーについて β 15/10/30(金) 17:52 発言[未読]
【77594】Re:特定ファイルのコピーについて SHO 15/10/31(土) 0:15 お礼[未読]

【77589】特定ファイルのコピーについて
質問  SHO  - 15/10/30(金) 15:47 -

引用なし
パスワード
   いつもこちらで勉強させていただいています
現在特定のファイルだけをコピーするマクロを作成しています

状況としましては
・SFolderのフォルダ内にAAAA_YYYYMMDD.xmlという形式でファイルが毎日分格納されている
・C8のセルにYYYYDDのフォーマットで月を指定する(例:201509)
・指定した月の1日以外と次の月の1日分のデータだけをDFolderにコピーしたい
 (9月分で指定すると20150902〜20151001分がコピーされてほしい)

Like演算子で9月分全部コピーするところまで出来たのですが、
当月の2日の除外と来月の1日の追加で躓いています。
無理やりManth+1 & 01 で20151001を作ってManth & 01で20150901を除外しようと思ったのですが
年が変わると使えなくなってしまうので困っています
知恵を貸していただけたら幸いです

作ったソースの一部です
不足あればご指摘ください
    
  Manth = cells(8,3)
  Set folderObj = fso.GetFolder(SFolder)
  For Each fileObj In folderObj.Files
    If fileObj.Name Like "*" & Manth & "*" Then
      fileObj.Copy DFolder
    End If
  Next

よろしくお願いします

【77590】Re:特定ファイルのコピーについて
発言  β  - 15/10/30(金) 17:52 -

引用なし
パスワード
   ▼SHO さん:

FSOを使ったほうが、そちらのコードにあうのでしょうが、標準機能だけで。
フォルダは、実際のものにしておいてください。

Sub Test()
  Dim SFolder As String
  Dim DFolder As String
  Dim fName As String
  Dim z As String
  Dim ym1 As String
  Dim ym2 As String
  Dim ym As String
  Dim tmp1 As Variant
  Dim tmp2 As Variant
  
  Dim ok As Boolean
  
  z = Range("C8").Value
  ym1 = Format(DateSerial(Left(z, 4), Mid(z, 5), 1), "yyyymm")
  ym2 = Format(DateSerial(Left(z, 4), Mid(z, 5) + 1, 1), "yyyymm")
  
  SFolder = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\SFolder\"
  DFolder = CreateObject("WScript.Shell").SpecialFolders("DeskTop") & "\DFolder\"
  
  fName = Dir(SFolder & "*.xml")
  
  Do While fName <> ""
    tmp1 = Split(fName, "_")
    tmp2 = Split(tmp1(UBound(tmp1)), ".")
    ok = False
    ym = tmp2(LBound(tmp2))
    Select Case Left(ym, 6)
      Case ym1
        If Right(ym, 2) <> "01" Then ok = True
      Case ym2
        If Right(ym, 2) = "01" Then ok = True
    End Select
    
    If ok Then
    
      On Error Resume Next
      Kill DFolder & fName
      On Error GoTo 0
      FileCopy SFolder & fName, DFolder & fName
    
    End If
      
    fName = Dir()
    
  Loop
  
End Sub

【77594】Re:特定ファイルのコピーについて
お礼  SHO  - 15/10/31(土) 0:15 -

引用なし
パスワード
   β様

レス遅くなり申し訳ありません

ご丁寧にソースまで書いていただきありがとうございました
LIKE演算子ばかりに捕らわれてしまい、このような書き方があるなんて想像しておりませんでした
とても参考になり助かりました
ありがとうございました

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