フォルダを開く、ファイルを開く、コードを閉じる、次のフォルダに移動する

Question

フォルダを開き、.xlsxファイルを開き、コードを実行し、.xlsxファイルを閉じるVBAスクリプトを探していました、次のフォルダに移動します（サブフォルダではありません）。私はそれを理解できません。次のように私のフォルダ構造は次のとおりです。

C：\ファイル\ [フォルダの何百] \ name.xlsx

各フォルダはその中の.xlsxファイルを持っていると私はこれらのファイルのすべての私のコードを実行する必要があります（1つのファイルでそれぞれ約1000のフォルダ）。

すべてのご協力をいただければ幸いです。ありがとう！

Answer 1

希望します。それに応じて外挿することができます。

Sub Openfile() 
    Dim MyFolder As String 
    Dim MyFile As String 
'The code below opens up the specified folder. 
'Replace the pathway with your own. 
'Keep the explorer.exe string. 
Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test", vbNormalFocus) 

'The code below opens up every excel file with .xlsx extension in the MyFolder path. 
MyFolder = "C:\Users\mvanover\Desktop\Test" 
MyFile = Dir(MyFolder & "\*.xlsx") 

Do While MyFile <> "" 
    Workbooks.Open Filename:=MyFolder & "\" & MyFile 
     MyFile = Dir 
Loop 
End Sub 

更新：

あなたのマクロ有効ワークブックに位置する細胞内のすべてのフォルダ名の入力やマクロ内のオブジェクトにそれらの値を設定してもできました。シェル関数内の文字列の最後にそのオブジェクトを追加することができます。例を以下に示します。

Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test\" & FolderName, vbNormalFocus) 

次に、各フォルダ名を通過するような簡単なループを設定し、それに応じて開くことができます。ループ内のコードは、すべてを開く/ 1つのExcelブックを実行し、実行するコードを実行し、各フォルダを閉じることで構成されます。同様のフォルダを閉じるためのコードを以下に示します。

Private Const CLOSE_WIN = &H10 
Dim Hwnd As Long 

Private Declare Function apiFindWindow _ 
    Lib "user32" Alias "FindWindowA" _ 
    (ByVal lpClassname As String, _ 
    ByVal lpWindowName As String) _ 
    As Long 

Private Declare Function apiPostMessage _ 
    Lib "user32" Alias "PostMessageA" _ 
    (ByVal Hwnd As Long, _ 
    ByVal wMsg As Long, _ 
    ByVal wParam As Long, _ 
    lParam As Any) _ 
    As Long 

申し訳ありません：

Call Shell("explorer.exe" & " " & "C:\Users\mvanover\Desktop\Test\" & FolderName, vbNormalFocus) 
DoEvents 
Hwnd = apiFindWindow("CabinetWClass", vbNullString) 
Dim retval As Long 
If (Hwnd) Then 
     retval = apiPostMessage(Hwnd, CLOSE_WIN, 0, ByVal 0&) 
End If 

が動作しませんだけでなく、あなたのサブステートメントの前に以下のコードまたは終値フォルダのコードを追加します。この新しいコードのすべてについて。実際には、フォルダを開くのに比べてフォルダを閉じるのがずっと難しくなります。私が終了コード F8でデバッグしていたときに動作します。

Answer 2

これは、 "C：\ Files \"で始まり、そのポイントの後に1つのサブフォルダがあるという基準に基づいて作成されるリスト "mfList"を使用します。そのようなフォルダはすべて「適格」となってリストに記録されます。リストを取得したら、それぞれのパスを調べ、そのパスの.xlsxファイルごとにコードを実行します。私は自分のプログラムの1つを取り出して操作したので、実際にはテストしていませんが、これがあなたにアイデアを与え、正しい方向に向けることを願っています。 （また、これらは関数ですが、適切な変数を使用して呼び出すサブルーチンを作成する必要があります）

Function MapFolders(fPath As String, Optional ByRef mfList As Collection, Optional NotTopLevel As Boolean) 

    Dim i As Long, Temp As String, nList As New Collection, mfVariant As Variant 

    On Error Resume Next: i = mfList.Count: On Error GoTo 0: If i = 0 Then Set mfList = nList 
    If Left(fPath, 9) = "C:\Files\" And InStr(Right(fPath, Len(fPath) - 9), "\") = InStrRev(Right(fPath, Len(fPath) - 9), "\") And Not InStr(Right(fPath, Len(fPath) - 9), "\") = 0 Then mfList.Add fPath 

    i = 1: Temp = SubFolder(fPath, i) 
    While Len(Temp) > 0 
     MapFolders Temp, mfList, True 
     i = i + 1: Temp = SubFolder(fPath, i) 
    Wend 
    If (Not mfList.Count = 0) And (Not NotTopLevel) Then Set mfVariant = Nothing: Set mfList = nList 
    Set nList = Nothing 

End Function 
Function SubFolder(fPath As String, i As Long) As String 

    Dim FSO As New FileSystemObject, FSOFolder As Object, FSOSubFolder As Object, FCount As Integer, j As Long 

    SubFolder = "": On Error Resume Next: Set FSOFolder = FSO.GetFolder(fPath): On Error GoTo 0 
    If FSOFolder Is Nothing Then Exit Function 

    On Error Resume Next: FCount = FSOFolder.SubFolders.Count: On Error GoTo 0 

    If i <= FCount Then 
     For Each FSOSubFolder In FSOFolder.SubFolders 
      j = j + 1: If j = i Then Exit For 
     Next FSOSubFolder 
     SubFolder = FSOSubFolder.Path & "\" 
    End If 

    Set FSO = Nothing: Set FSOFolder = Nothing 

End Function