(VBA)bat処理の結果がおかしい

質問

• VBAを使用して、(VBA)bat処理の結果が正しくないという問題があります。
• 具体的には、指定ディレクトリにBATファイルをコピーし、フォルダーを削除してからフォルダー名を変更する処理が正しく動作しないようです。
• 原因を調査して修正方法を教えていただきたいです。

回答No.8

kkkkkm

> BAT処理が完全に終わるのを待つ必要があるように思えます。

待つ処理は以下のサイトを参考にしてみてください。

VBA Sleep関数について、同じような機能を持つ他の関数やメソッドについても紹介
https://it-kyujin.jp/article/detail/1843/

補足

解説ありがとうございます。

試しに、最初のバッチの起動を
「同期の場合（バッチファイルの結果をVBAで待つ場合）」の下記に変えてみました。
Call obj.Run(sPath, WaitOnReturn:=True)

結果、stopを入れなくても処理が上手くできるようになりました。

一応、以下のコードで処理自体はできましたが、
修正すべき点あればお願いします。

------------------------------
私のコードは、ネットのコードを修正したり
過去教えてもらったコードで再利用できそうなコードの組み合わせだと
以前書きましたが、
そこでお聞きしたいのですが
　変数宣言(DIM)は、普通最初にまとめて宣言（記載）しまうが
　これが途中にある場合は、不都合がありますか。
　（もちろん、コードの順番では変数を利用する前の上方にはあります。）

今は、使いまわしのコードでdimがある場合は
　最初のsub()の直下になるように書き換えています。

（最初に「Option Explicit」を付けない場合は
　　そもそも変数宣言は必要ないがエラー修正が難しくなるので
　　宣言は行うようにはしています。）

------------------------------------------------------
Sub MooveUp_Directory()

Dim strPath As String
Dim intPathLen As Integer
Dim intR As Integer
Dim F As Variant
Dim obj As WshShell
Dim sPath As String
Dim folderPath As String
Dim CountFolder As Single
Dim strFlName As String
Dim SubF As Object
Dim MyF As Object
Dim ws01 As Worksheet
Dim lRow As Single
Dim FolderName, OldFile, NewFile As String

Dim MojiSuu As Single
Dim KokoKara As Variant

Dim I As Single
Dim Nukidashi As String
Dim EndRow As Single

'Range("A5:F100").Clear

' フォルダーを自由に選べること。 参考：officeTANAKA
With Application.FileDialog(msoFileDialogFolderPicker)
If .Show = True Then
If Len(.SelectedItems(1)) = 3 Then ' c:\の場合とサブフォルダーの場合
mypath = .SelectedItems(1)
Else
mypath = .SelectedItems(1) & "\"
End If
End If
End With

If mypath = Empty Then MsgBox "フォルダー名の指定をキャンセルしました。": Exit Sub

MyName = Dir(mypath, vbDirectory) ' 最初のフォルダ名を返します。

'Range("A2") = mypath 'コピー先フォルダーの指定

'BATファイルのコピー
FileCopy "C:\MoveUp_Directory.bat", mypath & "MoveUp_Directory.bat"

'batファイルの起動
sPath = mypath & "MoveUp_Directory.bat"
'MsgBox mypath
Set obj = New WshShell

ChDir mypath
Call obj.Run(sPath, WaitOnReturn:=True)

'フォルダー内の不要ファイルの削除
Kill mypath & "*.bat"
Kill mypath & "*.rar"

'フォルダー内のフォルダー数

folderPath = mypath '--- 含まれるフォルダ名を知りたいフォルダのパス ---'

'--- ファイルシステムオブジェクト ---'
Dim fso As Object
Set fso = CreateObject("Scripting.FileSystemObject")

'--- フォルダ数を格納する変数 ---'
Dim n As Long
CountFolder = fso.GetFolder(folderPath).SubFolders.Count

'フォルダー内のフォルダーを書き出す
Set MyF = fso.GetFolder(folderPath) ' 含まれるフォルダ名を知りたいフォルダを返します。

intR = 1
For Each SubF In MyF.SubFolders 'サブフォルダーを取得します。
Cells(intR, "A") = SubF.Name
intR = intR + 1
Next

Set fso = Nothing

'フォルダー名を元に戻す
'指定位置から文字列抜き出し()

With Sheets("DATA")
EndRow = .Cells(Rows.Count, "A").End(xlUp).Row
For I = 1 To EndRow
Nubering3 (I)
KokoKara = Application.InputBox(prompt:="何番目から抜き出すか？　数値を入力してください", Title:="指定位置（数値入力）", Type:=1)
If TypeName(KokoKara) = "Boolean" Then
MsgBox "数値以外が入力されたので終了します。"
Exit Sub
End If
.Activate
MojiSuu = Len(.Range("A" & I))
Nukidashi = Mid(.Range("A" & I), KokoKara, MojiSuu)
.Range("B" & I) = Nukidashi
Next I
End With
Sheets("Number").Range("A1:XX100").Clear

'FilenameChange() '指定したファイル名を変更します。

Set ws01 = Worksheets("DATA")

FolderName = mypath 'ターゲットフォルダー

lRow = ws01.Cells(Rows.Count, "A").End(xlUp).Row 'A列の最終行を取得

For I = 1 To lRow '最終行まで繰り返す

OldFile = FolderName & "\" & ws01.Cells(I, "A")
NewFile = FolderName & "\" & ws01.Cells(I, "B")

MsgBox NewFile

Name OldFile As NewFile 'ファイル名を変更します。

Next I

End Sub

Sub Nubering3(ByVal DataRow As Long)

Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim I As Long, j As Long, WRow As Long, WColumn As Long
Dim uRows As Range, uRange As Range
Dim font1 As Font

Set Ws1 = Sheets("DATA")
Set Ws2 = Sheets("Number")
Set uRows = Ws2.Rows(1)
Set uRange = Ws2.Range("A2")

'Numberシートの初期化（全体=数式・文字・書式・コメント全てをクリア）
Ws2.Range("A1:XX100").Clear

Application.ScreenUpda