PDA

View Full Version : [SOLVED] Using VBA to rename files - from Auotgenerated microscope to multiple array location.



jebarri
04-16-2015, 02:46 PM
I utilize a 72x72 well chip which is loaded into a microscope to take pictures of each well. It names the files in sequential order from top-right corner of the chip.

We load the chip in specific 8 arrays (fields) of 18x36, numbered 0-7.

I am trying to figure out how to rename the files, numbered *-0001.jpg, to (experiment name)_F1_R1_C1.jpg., where the notation designates Field (array), Row, and Column.

As an added challenge the chip is viewed upside down, meaning that the first photo generated is from Field 1, and the 37th photo is Field 0.
Field 1....Field 0
Field 3....Field 2
Field 5....Field 4
Field 7....Field 6

For example:
Let's say the Experiment name is defined as 20150416 but for simplicity I will leave it out in the namings below.
The first 72 photos should be named in the following trend -- 20150416_F1_R1_C1......._F1_R1_C18......_F1_R1_C36, _F0_R1_C1......_F0_R1_C36.
Then photo 73 would be _F1_R2_C1
and photo 1297 would be _F3_R1_C1
and photo 3889 would be _F7_R1_C1 ... I think you get the idea...
all the way to photo 5184 which should be _F6_R18_C36.

Any help or direction on this would be greatly appreciated.

Cheers.
Josh.

jebarri
04-16-2015, 02:55 PM
I am in the process of just 'hard coding' it but figured there might be a more creative // simpler method for attacking this.

mancubus
04-18-2015, 03:28 PM
i used array of arrays to beat the upside - down view

i assume a worksheet has 18Rx36C table

CreateNewFileNameList sub will be run once (unless field names and 18Rx36C don't change).

i tested with sample files and produced the file names as you specified.

sample file name begin with "-" character (since "*" character cannot be used in file names) followed by four digit number from 1 to 5184. i understand that file names contain strings. so i used a udf to extract numbers. this number gives the order in file name list.

see attached file.



Option Base 1

Sub CreateNewFileNameList()

Dim ArrF1F0 As Variant, ArrF3F2 As Variant, ArrF5F4 As Variant, ArrF7F6 As Variant
Dim ArrF As Variant, ArrRC, ArrPix()
Dim PixPath As String, NamesCount As Long
Dim j As Long, k As Long, m As Long, n As Long

'Replace Fx's with actual field names
ArrF1F0 = Array("F1", "F0")
ArrF3F2 = Array("F3", "F2")
ArrF5F4 = Array("F5", "F4")
ArrF7F6 = Array("F7", "F6")

ArrF = Array(ArrF1F0, ArrF3F2, ArrF5F4, ArrF7F6)

ArrRC = Worksheets("R18C36").Cells(1).CurrentRegion 'change worksheet name to suit

NamesCount = 8 * UBound(ArrRC, 1) * UBound(ArrRC, 2)
ReDim ArrPix(NamesCount) 'or Dim ArrPix(5184) instead and delete these 2 lines

For i = LBound(ArrF) To UBound(ArrF)
For j = 1 To 18
For k = 1 To 2
For m = 1 To 36
n = n + 1
ArrPix(n) = ArrF(i)(k) & "_" & ArrRC(j, m)
Next m
Next k
Next j
Next i

With Worksheets("PixNames") 'Change worksheet name to suit
.Cells.Clear
.Cells(1).Resize(5184) = Application.Transpose(ArrPix)
End With

End Sub





Sub RenameFiles()

Dim PixFile As Object
Dim PixPath As String, PixDate As String
Dim ArrPix

PixPath = "C:\test\" 'change to suit
PixDate = Format(Date, "yyyymmdd")
'PixDate = "20150430" 'if it is not current date, uncomment this line, insert desired date and delete above line
ArrPix = Worksheets("PixNames").Cells(1).CurrentRegion

With CreateObject("Scripting.FileSystemObject")
For Each PixFile In .GetFolder(PixPath).Files
.MoveFile PixPath & PixFile.Name, PixPath & PixDate & "_" & ArrPix(GetNumbers(PixFile.Name), 1) & Mid(PixFile.Name, InStr(PixFile.Name, "."))
Next PixFile
End With

End Sub




Function GetNumbers(AlphaNum As String) As String

With CreateObject("VBScript.RegExp")
.Global = True
.Pattern = "[^\d]+"
GetNumbers = .Replace(AlphaNum, vbNullString)
End With

End Function

jebarri
04-21-2015, 03:05 PM
Slow clap.
Outstanding. This works perfectly. I owe you maple syrup or something else stereotypically Canadian.

Seriously though, thank you.

Cheers.
Josh.

mancubus
04-21-2015, 11:45 PM
you are welcome.

please mark the thread as solved for future references. (from Thread Tools dropdown, above the first post.)


below is a slight modification to previous code to deal with different field and RC tables.

the number of fields must be even, needless to say. :)



Sub CreateNewFileNameList()
Dim ArrF1F0 As Variant, ArrF3F2 As Variant, ArrF5F4 As Variant, ArrF7F6 As Variant
Dim ArrF As Variant, ArrRC As Variant, ArrPix()
Dim PixPath As String, NamesCount As Long
Dim j As Long, k As Long, m As Long, n As Long

'Replace Fx's with actual field names
ArrF1F0 = Array("F1", "F0")
ArrF3F2 = Array("F3", "F2")
ArrF5F4 = Array("F5", "F4")
ArrF7F6 = Array("F7", "F6")

ArrF = Array(ArrF1F0, ArrF3F2, ArrF5F4, ArrF7F6)

ArrRC = Worksheets("R18C36").Cells(1).CurrentRegion 'change worksheet name to suit

NamesCount = UBound(ArrF) * UBound(ArrF(1)) * UBound(ArrRC, 1) * UBound(ArrRC, 2) '4 * 2 * 18 * 36
ReDim ArrPix(NamesCount)

For i = LBound(ArrF) To UBound(ArrF) '1 to 4
For j = LBound(ArrRC, 1) To UBound(ArrRC, 1) '1 to 18
For k = LBound(ArrF(i)) To UBound(ArrF(i)) '1 to 2
For m = LBound(ArrRC, 2) To UBound(ArrRC, 2) '1 to 36
n = n + 1
ArrPix(n) = ArrF(i)(k) & "_" & ArrRC(j, m)
Next m
Next k
Next j
Next i

With Worksheets("PixNames") 'Change worksheet name to suit
.Cells.Clear
.Cells(1).Resize(NamesCount) = Application.Transpose(ArrPix)
End With

End Sub