File Lister- (Code help) Pull File Name without Extension into Col

[Benjamin]

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

 

[Matthew Herbert]

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, bythe 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 permissionserror

            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

 

[ker_01]

Aircode:

from
.Offset(i, 0) = objFile.Name
to
.Offset(i, 0) = left(objFile.Name,len(objFile.Name)-4)

HTH
Keith