321-Tools

Post Reply
dirhaval
Posts: 791
Joined: Tue Feb 06, 2007 5:39 am

Here is some VBA code that I use to extract image file names with extension
to use in Fate, a 40 MB Excel file. Its 50 players so that is why so large.

Below code will not get cards associated with DC or RW versions; you can change that if you wish.
You need to change the variable FOLDERPATH to the directory with the cards.
first select a cell in a worksheet that will be the top of the file names, then
Run this macro/code to fill cells downward with names.

Upon review on this post; indenting is not simple.


Sub AddOlEObject()
'change path of folder, and column in worksheet to place file names
Dim mainWorkBook As Workbook

Set mainWorkBook = ActiveWorkbook
ActiveSheet.Activate
Folderpath = "E:\Metw\CentralPlains"
Set fso = CreateObject("Scripting.FileSystemObject")
NoOfFiles = fso.GetFolder(Folderpath).Files.Count
Set listfiles = fso.GetFolder(Folderpath).Files
For Each fls In listfiles
'within FOR
strCompFilePath = Folderpath & "\" & Trim(fls.Name)
If strCompFilePath <> "" Or Right(fls.Name, 6) <> "RW.jpg" Or Right(fls.Name, 6) <> "DC.jpg" Then
'within IF
If (InStr(1, strCompFilePath, "jpg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "jpeg", vbTextCompare) > 1 _
Or InStr(1, strCompFilePath, "png", vbTextCompare) > 1) Then
counter = counter + 1
ActiveSheet.Range("d" & counter).Value = strCompFilePath
'ActiveSheet.Range("B" & counter).ColumnWidth = 25
'ActiveSheet.Range("B" & counter).RowHeight = 100
'ActiveSheet.Range("B" & counter).Activate
'Call insert(strCompFilePath, counter)
ActiveSheet.Activate
End If
End If
Next

End Sub
Post Reply

Return to “Showcase”