• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

Help a.u.b. Macro's te begrijpen

Status
Niet open voor verdere reacties.

jupwijnen

Nieuwe gebruiker
Lid geworden
22 mrt 2017
Berichten
4
Hallo! na een tijd geprobeerd te hebben een excel document te kraken voor mijn college, ben ik in de VBA Code's gekomen. Mijn collega zegt dat hij niet in dusverre zoveel verstand van macro's heft dat hij dit kan begrijpen. Zou iemand mij kunnen helpen de code te begrijpen (Stap voor stap uit te leggen wat er gebeurd.)? :) Excel geeft een "error 445" kijken naar het stukje code dat is aangegeven met "*****"

Hartelijk dank!


CODE:

Sub look()

Set Data = ActiveWorkbook.Worksheets("Update")
***** Set fs = Application.FileSearch *****
Dim j As String

With fs ' looks in Folder "Update Files" files for excel files and lists them
.LookIn = ThisWorkbook.Path & "\Update Files" ' on sheet Update in cells BJ1 and following
.Filename = "*.xls"
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
Data.Activate
Cells(i, 62) = .FoundFiles(i)
Next i
Else

MsgBox "No Microsoft Excel files found." 'if folder is empty

End If
End With

End Sub


Sub look2() 'works like look

Set Data = ActiveWorkbook.Worksheets("Parameters")
Set fs = Application.FileSearch
Dim j As String

With fs
.LookIn = ThisWorkbook.Path & "\PC&L DB'S"
.Filename = "*.xls"
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
Data.Activate
Cells(i, 62) = .FoundFiles(i)
Next i
Else

MsgBox "No Microsoft Excel files found."

End If
End With

End Sub


Sub look3() 'works like look

Set Data = ActiveWorkbook.Worksheets("Output Inventory Segmentation")
Set fs = Application.FileSearch
Dim j As String

With fs
.LookIn = ThisWorkbook.Path & "\Inventory Segmentation Tool"
.Filename = "*.xls"
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
Data.Activate
Cells(i, 62) = .FoundFiles(i)
Next i
Else

MsgBox "No Microsoft Excel files found."

End If
End With

End Sub

Sub look4() 'works like look

Set Data = ActiveWorkbook.Worksheets("Update")
Set fs = Application.FileSearch
Dim j As String

With fs
.LookIn = ThisWorkbook.Path & "\Acquisition Tool"
.Filename = "*.xls"
If .Execute > 0 Then

For i = 1 To .FoundFiles.Count
Data.Activate
Cells(i, 62) = .FoundFiles(i)
Next i
Else

MsgBox "No Microsoft Excel files found."

End If
End With

End Sub
 
Het FileSearch object wordt volgens mij al sinds Office 2007 niet meer ondersteund.
Maak er dit van:
Code:
Sub look()
    Dim i As Integer
    Dim bst As String
        
    bst = Dir(ThisWorkbook.Path & "\Update Files\*.xls")
    If bst = "" Then
        MsgBox "No Microsoft Excel files found." 'if folder is empty
    Else
        While bst <> ""
            i = i + 1
            Sheets("Update").Cells(i, 62) = bst
            bst = Dir()
        Wend
    End If
End Sub
 
Hartelijk dank!

Zou je mij misschien ook uitleg kunnen geven over de code. Wat gebeurt er? Wij hebben de code zelf lokaal niet geschreven... En het zou heel veel werk zijn om elk commando te googlen.
Alvast bedankt!

Gr,
 
In vogelvlucht:
Code:
Sub look()
    Dim i As Integer    [COLOR="#008000"]'Tellertje[/COLOR]
    Dim bst As String   [COLOR="#008000"]'Bestandsnaam[/COLOR]
        
    bst = Dir(ThisWorkbook.Path & "\Update Files\*.xls") [COLOR="#008000"]'Naam eerste bestand[/COLOR]
    If bst = "" Then    [COLOR="#008000"]'Als deze leeg is (niet gevonden)[/COLOR]
        MsgBox "No Microsoft Excel files found."    [COLOR="#008000"]'Laat dat dan weten[/COLOR]
    Else
        While bst <> "" [COLOR="#008000"]'Zolang er een bestandsnaam wordt gevonden[/COLOR]
            i = i + 1   [COLOR="#008000"]'Ophogen tellertje[/COLOR]
            Sheets("Update").Cells(i, 62) = bst [COLOR="#008000"]'Plaats de naam van het bestand in het blad "Update" op regel i, kolom 62[/COLOR]
            bst = Dir() [COLOR="#008000"]'Haal de naam van het volgende bestand op[/COLOR]
        Wend
    End If
End Sub
 
Laatst bewerkt:
@

en while .... wend is in 2000 vervangen door do ... loop.
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan