Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.

Rename folder pomocu excel

[es] :: Office :: Excel :: Rename folder pomocu excel

[ Pregleda: 963 | Odgovora: 8 ] > FB > Twit

Postavi temu Odgovori

Autor

Pretraga teme: Traži
Markiranje Štampanje RSS

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
82.208.214.*



+2 Profil

icon Rename folder pomocu excel15.10.2019. u 20:58 - pre 54 meseci
Da li neko ima VBA da se pomocu excel preimenuju FOLDER-i, ne FILE-ovi.

Nasao sam neki vba ali za FILE, da li on moze da se preradi, stavljam sam deo vba



Sub RenameFiles()
ActiveSheet.Unprotect
Application.ScreenUpdating = False
Range("Filelist").Offset(1, 0).Select
RowCounter = 0
Unchanged = 0
If ActiveCell.Value = "" Then
MsgBox "No files detected", vbInformation, "Rename files"
Exit Sub
End If
MyPath = Range("Path").Value
If MyPath = "" Then
Application.ScreenUpdating = True
MsgBox "No Path specified", vbInformation, "Rename files"
Exit Sub
End If
If Right(MyPath, 1) <> "\" Then MyPath = MyPath & "\"
On Error GoTo BadFile
Do
If ActiveCell.Offset(RowCounter, 0).Interior.ColorIndex <> RenamedColour Then
NextFile = MyPath & ActiveCell.Offset(RowCounter, 0)
ChangeTo = MyPath & ActiveCell.Offset(RowCounter, 4)
RowCounter = RowCounter + 1
If NextFile = ChangeTo Then
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = UnchangedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "U"
Unchanged = Unchanged + 1
Else
Name NextFile As ChangeTo
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = RenamedColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "R"
End If
Else
RowCounter = RowCounter + 1
End If
Loop Until ActiveCell.Offset(RowCounter, 0).Value = ""
Application.ScreenUpdating = True
MsgBox RowCounter - Unchanged & " files renamed" & Chr(13) & Unchanged & " files unchanged", vbInformation, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
Exit Sub
BadFile:
Range("B" & RowCounter + Range("Filelist").Row & ":F" & RowCounter + Range("Filelist").Row).Interior.ColorIndex = ProblemColour
Range("E" & RowCounter + Range("Filelist").Row).Value = "P"
Range("Filelist").Offset(RowCounter, 0).Select
Application.ScreenUpdating = True
MsgBox "Problem with file..." & Chr(13) & Chr(13) & NextFile & Chr(13) & Chr(13) & "Error=" & Err.Description, vbCritical, "Rename files"
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, AllowFormattingCells:=True, AllowInsertingRows:=True, AllowDeletingRows:=True, AllowSorting:=True
End Sub
 
Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2267
89.216.49.*

Sajt: www.gowi.rs


+109 Profil

icon Re: Rename folder pomocu excel16.10.2019. u 09:56 - pre 54 meseci
Ista funkcija koju imaš u ovom kodu Name može da se iskoristi i za foldere. U najjednostavnijem obliku procedura bi bila:

Code:
Sub RenameFolder(oldName, newName)

   Name oldName As newName

End Sub


Ovde nema ispitavanja da li folder postoji, da li već ima sa takvim imenom itd

Pozivanje bi bilo
Code:
Sub Test()
  RenameFolder "D:\Test", "D:\Vojvoda"
End Sub


Nije to loše Rembrante, samo što ne bi dodao još malo boje?
 
Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
87.116.175.*



+2 Profil

icon Re: Rename folder pomocu excel16.10.2019. u 11:29 - pre 54 meseci
Ista funkcija koju imaš u ovom kodu Name može da se iskoristi i za foldere. U najjednostavnijem obliku procedura bi bila:

Code:
Sub RenameFolder(oldName, newName)

Name oldName As newName

End Sub





U gore navedenom kodu, da se samo ovo izmeni, ako sam dobro razumeo?
 
Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2267
89.216.49.*

Sajt: www.gowi.rs


+109 Profil

icon Re: Rename folder pomocu excel17.10.2019. u 08:45 - pre 54 meseci
Nisam se udubljivao šta radi kod koji si postavio, dovoljno je ovo što sam napisao za Rename foldera, ako upišeš odgovarajuće vrednosti u Test proceduru. Šta dalje imaš namaru sa tim nisi naveo

Evo u prilogu imaš test primer, pa probaj

Nije to loše Rembrante, samo što ne bi dodao još malo boje?
Prikačeni fajlovi
 
Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
87.116.175.*



+2 Profil

icon Re: Rename folder pomocu excel17.10.2019. u 12:00 - pre 54 meseci
Da pozove sve foldere i da ih preimenujem.


Vise foldera da preimenujem
 
Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2267
89.216.49.*

Sajt: www.gowi.rs


+109 Profil

icon Re: Rename folder pomocu excel17.10.2019. u 15:25 - pre 54 meseci
Napraviš petlju kroz listu i za svaki par iz liste pozoveš funckiju RenameFolder sa tim parametrima.
Nije to loše Rembrante, samo što ne bi dodao još malo boje?
 
Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
87.116.175.*



+2 Profil

icon Re: Rename folder pomocu excel18.10.2019. u 10:51 - pre 54 meseci
to je i problem
 
Odgovor na temu

vojvoda1010
nezaposlen

Član broj: 310516
Poruke: 547
82.208.214.*



+2 Profil

icon Re: Rename folder pomocu excel19.10.2019. u 11:06 - pre 54 meseci

Nesto sam uspeo,

Sub Folder_Name_To_Excel()
Dim FileSystem As Object, Folder As Object, SubFolder As Object
Dim InitialPath As String, b As Integer
b = 1
InitialPath = "C:\Users\A\Desktop\proba excel"
Set FileSystem = CreateObject("Scripting.filesystemobject")
Set Folder = FileSystem.GetFolder(InitialPath)
Range("A1").Select
For Each SubFolder In Folder.subfolders
ActiveSheet.Cells(b + 1, 1) = SubFolder
b = b + 1
Next SubFolder
End Sub


Sub RenameFolders()
Dim z As String
Dim s As String
Dim V As Integer
Dim TotalRow As Integer
TotalRow = ActiveSheet.UsedRange.Rows.Count
For V = 1 To TotalRow
z = Cells(V + 1, 1).Value
s = Cells(V + 1, 2).Value
Dim sOldPathName As String
sOldPathName = z
On Error Resume Next
Name sOldPathName As s
Next V
MsgBox "Congratulations! You have successfully renamed all the Folders"
End Sub


ali treba mi pomoc oko GetSourcePath

kako da ne nemnjam stalno InitialPath = "C:\Users\A\Desktop\proba excel", vec da mi ponudi odakle da vucem?
 
Odgovor na temu

Jpeca
Predrag Jovanović
poslovni analitičar
Gowi
Pančevo

Moderator
Član broj: 25683
Poruke: 2267
89.216.49.*

Sajt: www.gowi.rs


+109 Profil

icon Re: Rename folder pomocu excel21.10.2019. u 09:43 - pre 53 meseci
Ako želiš da koristiš sistemski dijalog da izabereš folder za GetSourcePath, preporučio bih ti da napraviš novu funkciju
Code:
Function GetFolder() As String
' Otvara dijalog za izbor foldera
' I vraca path izabranog foldera
'
Dim SelectedFolder As String
With Application.FileDialog(msoFileDialogFolderPicker)
    .Title = "Izaberi folder "
    .ButtonName = "Confirm"
    .InitialFileName = "C:\"

    If .Show = -1 Then
        'ok clicked
        SelectedFolder = .SelectedItems(1)
    Else
        SelecteFolder = ""
    End If
End With

GetFolder = SelectedFolder

End Function


Tu funckiju sada pozoveš u tvojoj proceduri

Code:
InitialPath = GetFolder()          ' Umesto InitialPath = "C:\Users\A\Desktop\proba excel"

Nije to loše Rembrante, samo što ne bi dodao još malo boje?
 
Odgovor na temu

[es] :: Office :: Excel :: Rename folder pomocu excel

[ Pregleda: 963 | Odgovora: 8 ] > FB > Twit

Postavi temu Odgovori

Navigacija
Lista poslednjih: 16, 32, 64, 128 poruka.