Excel VBA質問箱 IV

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

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


9348 / 76732 ←次へ | 前へ→

【72946】Re:フォルダ移動
回答  ウッシ  - 12/10/15(月) 9:41 -

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

ファイルが無い場合も移動前フォルダを削除する場合はIF文の外に
「移動前フォルダを削除」するコードを出して下さい。

'移動後フォルダ、移動前フォルダが存在するもの
'且つ、移動前フォルダにファイルが入っているとき
If myFso.FolderExists(oFold) And _
    myFso.FolderExists(nFold & "\" & mySuffix) And _
      myFso.GetFolder(nFold & "\" & mySuffix) _
        .Files.Count > 0 Then
  j = 0
  '移動後フォルダ内のサブフォルダを取得
  Set Fold_C = myFso.GetFolder(oFold).SubFolders
  'サブフォルダをループ
  For Each Fold_L In Fold_C
    '「mySuffix & "*"」に一致するものの連番の最大値
    If Fold_L.Name Like mySuffix & "*" Then
      If Val(Mid(Fold_L.Name, Len(mySuffix) + 1, _
            Len(Fold_L.Name))) >= j Then
        j = Val(Mid(Fold_L.Name, Len(mySuffix) + 1, _
              Len(Fold_L.Name))) + 1
      End If
    End If
  Next
  '連番の最大値+1を付けてフォルダ作成
  myFso.CreateFolder (oFold & "\" & mySuffix & j)
  '移動前フォルダから作成したフォルダへファイル移動
  myFso.MoveFile (nFold & "\" & mySuffix & "\*.*"), _
              (oFold & "\" & mySuffix & j)
  '移動前フォルダを削除
  myFso.Deletefolder (nFold & "\" & mySuffix), Force:=True
End If
1 hits

【72928】フォルダ移動 バッファー 12/10/13(土) 9:36 質問
【72934】Re:フォルダ移動 ウッシ 12/10/13(土) 12:10 回答
【72936】Re:フォルダ移動 バッファー 12/10/13(土) 16:55 発言
【72937】Re:フォルダ移動 ウッシ 12/10/14(日) 0:45 回答
【72945】Re:フォルダ移動 バッファー 12/10/15(月) 7:46 発言
【72946】Re:フォルダ移動 ウッシ 12/10/15(月) 9:41 回答
【72955】Re:フォルダ移動 バッファー 12/10/16(火) 19:11 お礼
【73042】Re:フォルダ移動 バッファー 12/10/30(火) 21:30 発言
【73043】Re:フォルダ移動 ウッシ 12/10/30(火) 23:40 回答
【73044】Re:フォルダ移動 バッファー 12/10/31(水) 21:08 お礼

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