Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
File Lister- (Code help) Pull File Name without Extension into Col
I'm trying to pull in *.dwg files into a Column
So I'll have a list of all my drawing files. I'm wondering if I can change the code so that it only pulls in the file name without the extension. Then that would save me some extra code and making more macros to remove the file extension from column with an additional macro. Sub Load_Files() 'dimension variables Dim objFSO As FileSystemObject, objFolder As Folder Dim objFile As File, strSourceFolder As String, x As Long, i As Long Dim wbNew As Workbook, wsNew As Worksheet ToggleStuff False 'turn of screenupdating Set objFSO = New FileSystemObject 'set a new object in memory strSourceFolder = BrowseForFolder 'call up the browse for folder routine If strSourceFolder = "" Then Exit Sub 'create a new workbook -Deleted this function-BDC -Workbooks.Add- Set wbNew = ActiveWorkbook Set wsNew = wbNew.Sheets(2) 'set the worksheet which is worksheet tab 2 wsNew.Activate 'format a header With wsNew.Range("A1:F1") .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size") .Interior.ColorIndex = 34 .Font.Bold = True .Font.Size = 12 End With With Application.FileSearch .LookIn = strSourceFolder 'look in the folder browsed to .FileType = msoFileTypeAllFiles 'get all files .SearchSubFolders = False 'don't search sub directories .Filename = "*.dwg" 'This selects what kind of File Type -We're using AutoCad Here .Execute 'run the search For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index) i = x 'make the variable i = x If x 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet i = x - 60000 'set i to the right number for row placement below Set wsNew = wbNew.Sheets.Add(After:=Sheets(wsNew.Index)) With wsNew.Range("A1:F1") .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _ "Last Accessed", "Size") .Interior.ColorIndex = 7 .Font.Bold = True .Font.Size = 12 End With End If On Error GoTo Skip 'in the event of a permissions error Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties With wsNew.Cells(1, 1) 'populate the next row with the variable data .Offset(i, 0) = objFile.Name .Offset(i, 1) = FORMAT(objFile.Size, "0,000") & " KB" .Offset(i, 2) = objFile.DateLastModified .Offset(i, 3) = objFile.DateLastAccessed .Offset(i, 4) = objFile.DateCreated .Offset(i, 5) = objFile.Path End With ' Next objFile Skip: 'this is in case a Permission denied error comes up or an unforeseen error 'Do nothing, just go to next file Next x wsNew.Columns("A:F").AutoFit End With 'clear the variables Set objFolder = Nothing Set objFile = Nothing Set objFSO = Nothing Set wsNew = Nothing Set wbNew = Nothing ToggleStuff True 'turn events back on |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
File Lister- (Code help) Pull File Name without Extension intoCol
On Jul 16, 10:01*am, Benjamin
wrote: I'm trying *to pull in *.dwg files into a Column So I'll have a list of all my drawing files. I'm wondering if I can change the code so that it only pulls in the file name without the extension. Then that would save me some extra code and making more macros to remove the file extension from column with an additional macro. Sub Load_Files() * * *'dimension variables * * Dim objFSO As FileSystemObject, objFolder As Folder * * Dim objFile As File, strSourceFolder As String, x As Long, i As Long * * Dim wbNew As Workbook, wsNew As Worksheet * * ToggleStuff False 'turn of screenupdating * * Set objFSO = New FileSystemObject 'set a new object in memory * * strSourceFolder = BrowseForFolder 'call up the browse for folder routine * * If strSourceFolder = "" Then Exit Sub * * 'create a new workbook -Deleted this function-BDC * -Workbooks.Add- * * Set wbNew = ActiveWorkbook * * Set wsNew = wbNew.Sheets(2) 'set the worksheet which is worksheet tab 2 * * wsNew.Activate * * *'format a header * * With wsNew.Range("A1:F1") * * * * .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size") * * * * .Interior.ColorIndex = 34 * * * * .Font.Bold = True * * * * .Font.Size = 12 * * End With * * With Application.FileSearch * * * * .LookIn = strSourceFolder 'look in the folder browsed to * * * * .FileType = msoFileTypeAllFiles 'get all files * * * * .SearchSubFolders = False 'don't search sub directories * * * * .Filename = "*.dwg" 'This selects what kind of File Type -We're using AutoCad Here * * * * .Execute 'run the search * * * * For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index) * * * * * * i = x 'make the variable i = x * * * * * * If x 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet * * * * * * * * i = x - 60000 'set i to the right number for row placement below * * * * * * * * Set wsNew = wbNew.Sheets.Add(After:=Sheets(wsNew.Index)) * * * * * * * * With wsNew.Range("A1:F1") * * * * * * * * * * .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _ * * * * * * * * * * "Last Accessed", "Size") * * * * * * * * * * .Interior.ColorIndex = 7 * * * * * * * * * * .Font.Bold = True * * * * * * * * * * .Font.Size = 12 * * * * * * * * End With * * * * * * End If * * * * * * On Error GoTo Skip 'in the event of a permissions error * * * * * * Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties * * * * * * With wsNew.Cells(1, 1) 'populate the next row with the variable data * * * * * * * * .Offset(i, 0) = objFile.Name * * * * * * * * .Offset(i, 1) = FORMAT(objFile.Size, "0,000") & " KB" * * * * * * * * .Offset(i, 2) = objFile.DateLastModified * * * * * * * * .Offset(i, 3) = objFile.DateLastAccessed * * * * * * * * .Offset(i, 4) = objFile.DateCreated * * * * * * * * .Offset(i, 5) = objFile.Path * * * * * * End With * * * * * * *' Next objFile Skip: * * * * * * *'this is in case a Permission denied error comes up or an unforeseen error * * * * * * *'Do nothing, just go to next file * * * * Next x * * * * wsNew.Columns("A:F").AutoFit * * End With * * *'clear the variables * * Set objFolder = Nothing * * Set objFile = Nothing * * Set objFSO = Nothing * * Set wsNew = Nothing * * Set wbNew = Nothing * * ToggleStuff True 'turn events back on Benjamin, Use the Object Browser (View | Object Browser) to search for "FileSystemObject". You'll notice that the class has a number of methods associated with it. You are likely looking for GetBaseName. (You can also search "GetBaseName" in VBE Help. The help file states the following: "Returns a string containing the base name of the last component, less any file extension, in a path." If this isn't what you are looking for, then click the "See Also" link within the GetBaseName help file to search other related methods). Dim strBaseName strBaseName = objFSO.GetBaseName(objFile.Path) Best, Matthew Herbert |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
File Lister- (Code help) Pull File Name without Extension into Col
Aircode:
from .Offset(i, 0) = objFile.Name to .Offset(i, 0) = left(objFile.Name,len(objFile.Name)-4) HTH Keith "Benjamin" wrote: I'm trying to pull in *.dwg files into a Column So I'll have a list of all my drawing files. I'm wondering if I can change the code so that it only pulls in the file name without the extension. Then that would save me some extra code and making more macros to remove the file extension from column with an additional macro. Sub Load_Files() 'dimension variables Dim objFSO As FileSystemObject, objFolder As Folder Dim objFile As File, strSourceFolder As String, x As Long, i As Long Dim wbNew As Workbook, wsNew As Worksheet ToggleStuff False 'turn of screenupdating Set objFSO = New FileSystemObject 'set a new object in memory strSourceFolder = BrowseForFolder 'call up the browse for folder routine If strSourceFolder = "" Then Exit Sub 'create a new workbook -Deleted this function-BDC -Workbooks.Add- Set wbNew = ActiveWorkbook Set wsNew = wbNew.Sheets(2) 'set the worksheet which is worksheet tab 2 wsNew.Activate 'format a header With wsNew.Range("A1:F1") .Value = Array("File", "Size", "Modified Date", "Last Accessed", "Created Date", "Full Path", "Size") .Interior.ColorIndex = 34 .Font.Bold = True .Font.Size = 12 End With With Application.FileSearch .LookIn = strSourceFolder 'look in the folder browsed to .FileType = msoFileTypeAllFiles 'get all files .SearchSubFolders = False 'don't search sub directories .Filename = "*.dwg" 'This selects what kind of File Type -We're using AutoCad Here .Execute 'run the search For x = 1 To .FoundFiles.Count 'for each file found, by the count (or index) i = x 'make the variable i = x If x 60000 Then 'if there happens to be more than multipls of 60,000 files, then add a new sheet i = x - 60000 'set i to the right number for row placement below Set wsNew = wbNew.Sheets.Add(After:=Sheets(wsNew.Index)) With wsNew.Range("A1:F1") .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _ "Last Accessed", "Size") .Interior.ColorIndex = 7 .Font.Bold = True .Font.Size = 12 End With End If On Error GoTo Skip 'in the event of a permissions error Set objFile = objFSO.GetFile(.FoundFiles(x)) 'set the object to get it's properties With wsNew.Cells(1, 1) 'populate the next row with the variable data .Offset(i, 0) = objFile.Name .Offset(i, 1) = FORMAT(objFile.Size, "0,000") & " KB" .Offset(i, 2) = objFile.DateLastModified .Offset(i, 3) = objFile.DateLastAccessed .Offset(i, 4) = objFile.DateCreated .Offset(i, 5) = objFile.Path End With ' Next objFile Skip: 'this is in case a Permission denied error comes up or an unforeseen error 'Do nothing, just go to next file Next x wsNew.Columns("A:F").AutoFit End With 'clear the variables Set objFolder = Nothing Set objFile = Nothing Set objFSO = Nothing Set wsNew = Nothing Set wbNew = Nothing ToggleStuff True 'turn events back on |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Determine Excel file version with no file extension. | Excel Discussion (Misc queries) | |||
Retrieving Excel File extension based on XL File Format Enumeratio | Excel Programming | |||
file format or file extension is not valid...error message | Excel Discussion (Misc queries) | |||
Additional file with no extension created during File Save As proc | Excel Discussion (Misc queries) | |||
I need to download an exel spreadsheet file. (file extension :xls) | Excel Discussion (Misc queries) |