moving folders based on a criteria

[blackguard4]

i need help making a macro to move a folder based on a file that can be read with a notepad starting from line 41-60,so if line 41 start with 2b-.... then the whole folder that contain that file would be moved to a folder called 2b. is this even possible?
also where would you recommennd for me to learn the basic of VB?
i need to move around 26k folders.. so help is appreciated. thank you

[Bob Phillips]

Are you saying that you have 26,000 folders, and all of these folders have multiple files that you want to check to see if ANY of them have a certain piece of text, if so rename that folder?

That seems extreme. How did you get to this position, what is the rationale for doing this?

[Kenneth Hobs]

It is fine to start a new thread which is proper but it would help if you posted the link to what you did before. http://www.vbaexpress.com/forum/showthread.php?p=272632

So, did you really need what was in the other thread or did you just need this instead? The solution makes a difference. We can code after we write that row or we can run a separate macro later and check columns 3 and 4 and move the folder then. Moving is easily done. I guess you would want to make it a subfolder of the 2b folder.

[blackguard4]

they are all cable test results and each folder are named like this " 04210220120615jw20100673 ", inside that folder there is a file that i can open with a notepad, at line 41, it shows the actual label for the cable, instead of a mumbo jumbo folder name.. for example "2a-50-D3", i need to be able to sort per tile based on that label. there are 3 tile per floor A,B,C. a macro for one is fine, i can just change the tile later.

[vba]Sub ListFoldersAndInfo()

Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet
Dim s As String, fn As String

FolderName = "S:\36404 - GTAP\6-Systems\27 11 19 Structured Cabling\1-Take off\01 Commissioning\JDSU Tester Reference\TestResults Raw Data (Current)"

Set Wks = Worksheets("Sheet1")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\xpertresults.VRF"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\xpertresults.VRF"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)
Next Folder

Set FSO = Nothing

End Sub

Function TXTStr(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
TXTStr = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

TXTStr = str
End Function
[/vba]
or with the above macro, it extracts it and shows the folder name and label side by side in excel. but i have no way of moving each folder into their proper folder per tile.

in excel it shows like this ,based on that macro

04201320120601jw20100539 6B-05-D5 04210020120519jw20100673
4B-29-D3

the end result that i need is 04201320120601jw20100539 folder, which contain txt file that said label 6B-05-D5. be moved into a folder called 6B

i need to do this because if i named the folder differently, the software that needs to read the folder, wont recognize it, as a result i have to open each folder, then open the text file and i have to move each of them by hand many times
help is really appreciated.

[snb]

It would be nice if you read a Basic VBA book to get acquainted with terminology: what is a folder, what is a workbook, what is a file, what is a worksheet.

You probably need only this code:

[vba]Sub snb()
with createobject("scripting.filesystemobject")
sn=split(.exec("cmd /c Dir S:\36404 - GTAP\6-Systems\27 11 19 Structured Cabling\1-Take off\01 Commissioning\JDSU Tester Reference\TestResults Raw Data (Current)\xpertresults.VRF /b /s").stdout.readall,vbcrlf)

for j=0 to ubound(sn)
msgbox split(.opentextfile(sn(j)).readall,vbcrlf)(41)
next
end with
End Sub[/vba]

What you want to do if you have found the cable name in the file is as clear as mud to me, and that appears rather hard to code...

[blackguard4]

thank you for the help, but i dont understand wat the code is doing? its giving me error the drive doesnt support this property or method

if i have the label then i can move the folder that contains that file to be moved to the appropriate folder based on the label..

/c: Test\04220620120626jw20100673\xpertresults.prf

inside xpertresults.prf that i can open with notepad, on line 41 is the label 2b-30-d5
i need to move that 04220620120626jw20100673 folder into a folder called 2B based on that label


i'll definitely be learning VB after im done with this, i think it would be helpful for me

[Kenneth Hobs]

I use the DOS command, Move. To see the help for Move, Win+E, type cmd, and OK. Then type, Help Move. You can add a /Y or /-Y command line switch. You will see that snd uses shell commands often.

[VBA]Sub ListFoldersAndInfo()

Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet
Dim s As String, fn As String, sLabel As String, pFolder As String

FolderName = "E:\TestResults"
pFolder = "c:\temp\"

Set Wks = Worksheets("Sheet2")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\ken.bin"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\ken.bin"
s = TXTStr(fn)
If Len(s) >= 61 Then
sLabel = Mid(s, 41, 19)
Rng.Cells(R, 4) = sLabel
If Folder.Name <> sLabel Then Shell ("cmd /c Move " & Folder.Path & " " & pFolder & sLabel)
End If
Next Folder

Set FSO = Nothing

End Sub

Function TXTStr(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
TXTStr = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

TXTStr = str
End Function

[/VBA]

[blackguard4]

[VBA]Sub ListMaster()

Dim FSO As Object
Dim Folder As Object
Dim FolderName As String
Dim R As Long
Dim Rng As Range
Dim SubFolder As Object
Dim Wks As Worksheet
Dim s As String, fn As String, sLabel As String, pFolder As String

FolderName = "C:\Users\richard\Desktop\New folder\TestResults"
pFolder = "C:\Users\richard\Desktop\New folder\Result"

Set Wks = Worksheets("Sheet5")
Set Rng = Wks.Range("A2")
Wks.UsedRange.Offset(1, 0).ClearContents

Set FSO = CreateObject("Scripting.FileSystemObject")

Set Folder = FSO.GetFolder(FolderName)
R = 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\xpertresults.VRF"
s = TXTStr(fn)
If Len(s) >= 61 Then Rng.Cells(R, 4) = Mid(s, 41, 19)

For Each Folder In Folder.SubFolders
R = R + 1
Rng.Cells(R, 1) = Folder.Name
Rng.Cells(R, 2) = Folder.Path
Rng.Cells(R, 3) = Folder.Size
fn = Folder.Path & "\xpertresults.VRF"
s = TXTStr(fn)
If Len(s) >= 61 Then
sLabel = Mid(s, 41, 19)
Rng.Cells(R, 4) = sLabel
If Folder.Name <> sLabel Then Shell ("cmd /c Move /-y " & Folder.Path & " " & pFolder & sLabel)
End If
Next Folder

Set FSO = Nothing

End Sub

Function TXTStr(filePath As String) As String
Dim str As String, hFile As Integer

If Dir(filePath) = "" Then
TXTStr = "NA"
Exit Function
End If

hFile = FreeFile
Open filePath For Binary Access Read As #hFile
str = Input(LOF(hFile), hFile)
Close hFile

TXTStr = str
End Function[/VBA]

i put the -y to give me prompt i dont think it works, also the 1st time itried w/o the /-y it only works once. am i missing something?

[Kenneth Hobs]

There is no need to quote code again unless you made a change other than just folder and filename paths. Of course in this case, your pFolder shows that you skipped the trailing backslash character as I had in mine. If you step through the code, you will see those sorts of things if you look at the variable values after their line of code executes by hovering the mouse over them. e.g. c:\folder\subfolder versus c:\foldersubfolder.

I don't know your data. Maybe you only had one subfolder that had that file. It does nothing if the file is in Folder.Path, the main parent folder. You will need to code for that if that might happen.

Step through the code with F8 to see what is going on.

[blackguard4]

each subfolder have a notepad file associated with it,so it should pretty much move all the folders. it did work the 1st time, it moved the folder and changing the name for it, after i tried changing the source n pfolder it doesnt work anymore

[Kenneth Hobs]

When shelling, you may need to surround parameter with quotes if they have space characters. e.g.
[vba]
dim q as String
q=""""
If Folder.Name <> sLabel Then Shell ("cmd /c Move /-y " & q & Folder.Path & q & " " & q & pFolder & sLabel & q) [/vba]

[blackguard4]

i put the /-y to prompt me if it had copy 2 files that have the same name, but it didnt do it

[Kenneth Hobs]

What do you mean copy? What do you mean file? Your stated goal was to Move Folders. Moving the folder moves it and all the files in it plus any subfolders in it.