Å vite hvordan du kan hente Excel-filer fra flere mapper ved hjelp av Visual Basic for Applications (VBA ) kan spare deg for tid når du må søke på datamaskinen din for Excel-filer til å lagre dem i en mappe . VBA kan brukes i Microsoft Office- programmer som Excel til å automatisere rutineoppgaver som søker etter filer i mapper . Den beste måten å søke etter filer i flere mapper er ved hjelp av rekursiv programmering. Rekursiv programmering brukes når du trenger en funksjon for å kalle seg i funksjonen . Du trenger
Microsoft Office
Vis flere instruksjoner
en

Launch Microsoft Office Excel , klikk på " Developer ", og klikk " Visual Basic " for å starte VB Editor . Klikk på " Insert"-menyen og klikk " Module" for å sette inn en ny kode modul
2

Skriv inn følgende for å opprette en ny sub - prosedyre : .

Dim colFiles Som ny samling
3

Kopier og lim inn følgende for å opprette variabler : en

Dim extractPath As String

Dim filnavn As String

Dim pos As Integer
4

Definer banen der du vil kopiere Excel-filer funnet : en

extractPath = "C : \\ Temp \\ "
5

Legg til følgende kode for å kalle den funksjonen som finner Excel-filer for utvinning :

RecursiveDir colFiles , "F : \\ moreExcelFiles \\ ", " . * xlsx " , Sann
6 < p> Legg til følgende kode for å kopiere filene funnet til banen definert i trinn 3 : en

Dim vFile Som Variant

Hver vFile i colFiles

pos = InStrRev ( vFile , "\\" , , vbTextCompare )

fileName = Høyre ( vFile , Len ( vFile ) - pos)

FileCopy vFile , extractPath & fileName

Neste vFile

End sub ​​
7

Definer " RecursiveDir " funksjonen for å søke i mapper og undermapper for Excel-filer : en

Public Function RecursiveDir ( colFiles Som Collection, _

strFolder As String , _

strFileSpec As String , _

bIncludeSubfolders Som Boolean )

Dim strTemp Som String

Dim colFolders Som ny samling

Dim vFolderName Som Variant

strFolder = TrailingSlash ( strFolder )

strTemp = Dir ( strFolder & strFileSpec )

Mens strTemp < > ; vbNullString

colFiles.Add strFolder & strTemp

strTemp = Dir

Loop
p Hvis bIncludeSubfolders Deretter

strTemp = Dir ( strFolder , vbDirectory )

Mens strTemp < > vbNullString
p Hvis ( strTemp < > " . ") Og ( strTemp < > ".." ) Så
p Hvis ( GetAttr ( strFolder & strTemp ) og vbDirectory ) < > 0 Then

colFolders.Add strTemp

End If

End If
< p> strTemp = Dir

Loop

Hver vFolderName I colFolders

Ring RecursiveDir ( colFiles , strFolder & vFolderName , strFileSpec eller sann)

Neste vFolderName

End If

End Function
8

Opprett følgende funksjon for å legge til eller fjerne " \\" fra mappebanene : en

Public funksjon TrailingSlash ( strFolder As String ) As String
p Hvis Len ( strFolder ) > 0 Then
p Hvis Høyre ( strFolder , 1 ) = "\\ " Da

TrailingSlash = strFolder

Else

TrailingSlash = strFolder & " \\"

End If

End If

End Function

9

klikk i " extractExcelFiles " sub - prosedyre og klikk " F5 " for å kjøre programmet .