Forum Coders' city Strona Główna Coders' city
Nasza pasja to programowanie!
 

 PomocPomoc   SzukajSzukaj   UżytkownicyUżytkownicy   GrupyGrupy  RejestracjaRejestracja 
Archiwum starego forum + teoria    RSS & Panel/SideBar
 ProfilProfil   Zaloguj się, by sprawdzić wiadomościZaloguj się, by sprawdzić wiadomości   ZalogujZaloguj 

Potrzebuję szybkiej odpowiedzi na moje pytanie... Zasady

[VBS] skrypt segregujący pliki w katalogi



 
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Inne języki skryptowe, przetwarzanie danych
Zobacz poprzedni temat :: Zobacz następny temat  
Autor Wiadomość
causative



Dołączył: 12 Lut 2008
Posty: 41

PostWysłany: Wto Wrz 16, 2014 11:16 am  OP    Temat postu: [VBS] skrypt segregujący pliki w katalogi Odpowiedz z cytatem Pisownia

Witam,
Poniżej działający skrypt "omegastripes" kopiujący luźne pliki do katalogów miesięcznych wg. nazwy miesiąca i roku w nazwie pliku.
Skrypt działa dla nazw plików:
- production_Jan_14_999
- production_Mar_14_999
- production_Jul_13_999
- production_Aug_12_999

Jak należałoby zmienić ten skrypt aby działał poprawnie przy założeniu że nazwy plików są inne tzn:
"zmiennaJan14zmienna" lub "zmiennaMar13zmienna"
czyli maska takich plików to zmiennammmyyzmienna

Kod:
Option Explicit  
Dim sSrcFolder, sDstFolder, oFso, oMonths, lLoc, i, oFile, arrParse, sPutFolder, lCountFolders, lCountFiles  


' Source folder with files  
sSrcFolder = "C:\test\src"  
' Destination folder to copy files to  
sDstFolder = "C:\test\dst"  


' Check whether source folder exists  
Set oFso = CreateObject("Scripting.FileSystemObject")  
If Not oFso.FolderExists(sSrcFolder) Then  
     MsgBox "Source folder" & vbCrLf & """" & sSrcFolder & """" & vbCrLf & "is not found", 16  
     WScript.Quit  
End If  


' Put all month's short names in english into dictionary  
Set oMonths = CreateObject("Scripting.Dictionary")  
lLoc = SetLocale(1033)  
For i = 1 to 12  
     oMonths(MonthName(i, true)) = i  
Next  
SetLocale lLoc  
' Make sure destination folder exists  
SmartCreateFolder sDstFolder  
' Check each file in source folder  
lCountFolders = 0  
lCountFiles = 0  
For Each oFile in oFso.GetFolder(sSrcFolder).Files  
     ' Put filename parts into array  
     arrParse = Split(oFso.GetBaseName(oFile.Name), "_")  
     ' Check whether the filename explicitly matches the mask: production_<3 letters month>_<2 digits year>_<any value>  
     Select Case False  
     Case UBound(arrParse) = 3  
     Case arrParse(0) = "production"  
     Case oMonths(arrParse(1)) <> Empty  
     Case Len(arrParse(2)) = 2  
     Case IsNumeric(arrParse(2))  
     ' All criterias match  
     Case Else  
         ' Generate destination nested folder for file  
         sPutFolder = sDstFolder & "\" & arrParse(1) & "_" & arrParse(2)  
         ' Create folder if not found  
         If Not oFso.FolderExists(sPutFolder) Then  
             oFso.CreateFolder(sPutFolder)  
             lCountFolders = lCountFolders + 1  
         End If  
         ' Copy source file to destination location  
         oFso.CopyFile oFile.Path, sPutFolder & "\" & oFile.Name  
         lCountFiles = lCountFiles + 1  
     End Select  
      
Next  
MsgBox "Folders created: " & vbTab & vbTab & lCountFolders & vbCrLf & "Files copied: " & vbTab & vbTab & lCountFiles & vbCrLf & "Files checked: " & vbTab & vbTab & oFso.GetFolder(sSrcFolder).Files.Count  


Sub SmartCreateFolder(strFolder)  
     ' http://www.visualbasicscript.com/tm.aspx?m=29290  
     With CreateObject("Scripting.FileSystemObject")  
         If Not .FolderExists(strFolder) then  
             SmartCreateFolder(.getparentfoldername(strFolder))  
             .CreateFolder(strFolder)  
         End If  
     End With  
End Sub
Powrót do góry
Zobacz profil autora Wyślij prywatną wiadomość
Wyświetl posty z ostatnich:   
Odpowiedz do tematu    Forum Coders' city Strona Główna -> Inne języki skryptowe, przetwarzanie danych Wszystkie czasy w strefie CET (Europa)

Strona 1 z 1

 
Skocz do:  
Możesz pisać nowe tematy
Możesz odpowiadać w tematach
Nie możesz zmieniać swoich postów
Nie możesz usuwać swoich postów
Nie możesz głosować w ankietach
Możesz dodawać załączniki na tym forum
Możesz pobierać pliki z tego forum




Debug: strone wygenerowano w 0.14187 sekund, zapytan = 11
contact

| Darmowe programy i porady Jelcyna | Tansze zakupy w Helionie | MS Office Blog |