Klasörü aç, dosyayı aç, kodu çalıştır, dosyayı kapat, bir sonraki klasöre git

Question

Bir klasör açacak, bir .xlsx dosyasını açacak, kodumu çalıştıracağım bir VBA komut dosyası arıyorum .xlsx dosyasını kapatın ve bir sonraki klasöre gidin (alt klasöre değil). Sadece anlayamıyorum. aşağıdaki gibi Benim klasör yapısı şöyledir:

C: Files \ \ [klasörler yüzlerce] \ name.xlsx

Her klasör içinde bir .xlsx dosyası vardır ve ben bu dosyaların hepsi benim kod çalıştırmasına gerek (1 dosya ile yaklaşık 1000 klasör).

Her türlü yardım çok takdir edilecektir! Teşekkürler!

Answer 1

Bu yardımcı olur umarım. Buna göre tahmin yapabilirsiniz.

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 

Güncelleme:

Tüm klasör makro özellikli çalışma kitabında bulunan hücrelerde isimler ve makro bir nesneye bu değerleri ayarlamak girişi de olabilir. Daha sonra bu nesneyi kabuk işlevinde bulunan dizenizin sonuna ekleyebilirsiniz. Bir örnek aşağıda gösterilmiştir: Bu durumda, her bir klasör adı geçmesi ve buna göre açacak kolay bir döngü kurmak olabilir

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

. Bu döngü içindeki kodunuz, çalıştırmak istediğiniz kodu çalıştıran ve/veya her bir klasörü kapatan tüm/bir excel çalışma kitabını/kitaplarını açmayı içerir. yanı klasörleri kapatılması için kod aşağıda gösterilmiştir:

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 

Maalesef:

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 

çalışmaz yanı da alt deyimi önce aşağıda gösterilen kodu veya kapanış klasör kodu ekleyin Bütün bu yeni kod hakkında. Açmakla karşılaştırıldığında bir klasörü kapatmak çok daha zor. kapanış kodu F8 ile hata ayıklama yaparken çalışıyor.

Answer 2

Bu, "C: \ Files \" ile başlattığı ölçütlere göre oluşturulan ve bu noktadan sonra tam olarak bir alt klasöre sahip olan "mfList" listesini kullanır. Listede kaydedilecek tüm bu klasörler "kalifiye". Listeye sahip olduğunuzda, yolların her birini ve bu yoldaki her .xlsx dosyası için kodunuzu çalıştırabilirsiniz. Programlarımdan birini aldım ve manipüle ettim, bu yüzden gerçekten test etmedim, ama umarım bu size bir fikir verir ve doğru yöne işaret eder. (Ve yine bu işlevler, elbette, uygun değişkenlerle onları çağıran altprogramı oluşturmanız gerekir).

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