Results 1 to 16 of 16

32 bit macro converted to 64 bit

Threaded View

  1. #1
    Registered User
    Join Date
    06-26-2013
    Location
    Ohio
    MS-Off Ver
    Excel 2010
    Posts
    8

    32 bit macro converted to 64 bit

    I have a macro I found on the internet many years ago and have found many uses for it.
    It collects a basic listing of file names and paths.

    I'm using Office 365 Pro Plus, Excel 32 bit.
    I would like some people in another office to collect information for me but they are using Office 365 Pro Plus, Excel 64 bit.
    I do not have 64bit to test it on.

    Is there a way to install both 64 bit and 32 version of Excel and choose which I use?

    I've converted a couple of lines in the macro from info I found on the internet but it still doesn't run.
    Any ideas?

    Excel File Attached
    Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
    End Type
    
    'API declarations
    
    '32 bit code
    'Declare Function SHGetPathFromIDList Lib "shell32.dll" _
    'Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Long
    
    'Declare Function SHBrowseForFolder Lib "shell32.dll" _
    'Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
    
    '64 bit code
    Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" _
    Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Long
    
    Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" _
    Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
        
    
    Function Get_File(f_cell)
    'Pull the path off the file name
    'in the excel cell type "=get_file(a1)"
    
    Top:
      If InStr(1, f_cell, "\") Then
        f_cell = Right(Trim(f_cell), Len(Trim(f_cell)) - InStr(1, f_cell, "\"))
        GoTo Top
     End If
     Get_File = f_cell
    End Function
    
    Function get_dwg_number(f_cell)
    'pull drawing number from the left to the first space
        
        get_dwg_number = Left(Get_File(f_cell), InStr(1, f_cell, " ") - 1)
    
    End Function
    
    Function get_desc(f_cell)
    'Pull description after the drawing number and first space
    
        get_desc = Right(Trim(Get_File(f_cell)), Len(Trim(Get_File(f_cell))) - InStr(1, Get_File(f_cell), " "))
        get_desc = Left(get_desc, Len(get_desc) - 4)
    
    End Function
    -------------------------
    Private Sub CommandButton1_Click()
        TestListFilesInFolder
    End Sub
    
    Sub TestListFilesInFolder()
        
    'Set column headers
        With Range("A1")
            .Font.Bold = True
            .Font.Size = 12
        End With
        Range("A1").Formula = "Files in " & TextBox1
    '    Range("B1").Formula = "Path and File:"
    '    Range("C1").Formula = "File Size:"
    '    Range("D1").Formula = "Date Created:"
    '    Range("E1").Formula = "Date Last Modified:"
    '    Range("F1").Formula = "Owner:"
    '    Range("H1").Formula = "Path:"
    '    Range("I1").Formula = "File:"
    '    Range("I1").Formula = "File:"
    '    Range("J1").Formula = "Programmer:"
    '    Range("K1").Formula = "Charged Out:"
    '    Range("L1").Formula = "Update Date:"
    '    Range("M1").Formula = "Days old:"
    '    Range("N1").Formula = "EC1:"
    '    Range("O1").Formula = "EC2:"
    '    Range("P1").Formula = "EC3:"
        Range("A1:P1").Font.Bold = True
        Range("A2:P2500").Font.Bold = False
        
    'Add comments
    '    Range("N1").Select
    '    Selection.ClearComments
    '    Range("O1").Select
    '    Selection.ClearComments
    '
    '    Range("N1").AddComment
    '    Range("N1").Comment.Visible = False
    '    Range("N1").Comment.Text Text:="Is this charged out" & Chr(10) & "in MOM?" & Chr(10) & ""
    '    Range("N1").Select
        
    '    Range("O1").AddComment
    '    Range("O1").Comment.Visible = False
    '    Range("O1").Comment.Text Text:="Has it been charged out" & Chr(10) & "more than 30 days?" & Chr(10) & ""
    '    Range("O1").Select
        
         
        If TextBox1 > "" Then
            ListFilesInFolder TextBox1, CheckBox1
        Else
            MsgBox "Enter a path to list."
        End If
    
    End Sub
    Sub ListFilesInFolder(ByVal SourceFolderName As String, ByVal IncludeSubfolders As Boolean)
    ' lists information about the files in SourceFolder
    ' example: ListFilesInFolder "C:\FolderName\", True
      Dim FSO As Object
      Dim SourceFolder As Object
      Dim SubFolder As Object
      Dim FileItem As Object
      Dim r As Long
      
         Set FSO = CreateObject("Scripting.FileSystemObject")
         Set SourceFolder = FSO.GetFolder(SourceFolderName)
         
           r = Range("A65536").End(xlUp).Row + 1
           For Each FileItem In SourceFolder.Files
            'display file properties
            If IncludeSubfolders Then
                Cells(r, 1).Formula = FileItem.path
            Else
                Cells(r, 1).Formula = FileItem.Name
            End If
    '         Cells(r, 3).Formula = FileItem.Size
    '         Cells(r, 4).Formula = FileItem.DateCreated
    '         Cells(r, 5).Formula = FileItem.DateLastModified
    '         Cells(r, 6).Formula = GetFileOwner(SourceFolder.path, FileItem.Name)
             r = r + 1 ' next row number
             x = SourceFolder.path
           Next FileItem
           
           If IncludeSubfolders Then
             For Each SubFolder In SourceFolder.SubFolders
               ListFilesInFolder SubFolder.path, True
             Next SubFolder
           End If
           
        Columns("A:A").EntireColumn.AutoFit
        
        Set FileItem = Nothing
        Set SourceFolder = Nothing
        Set FSO = Nothing
        
        ActiveWorkbook.Saved = True
        
    End Sub
    
    Function GetFileOwner(ByVal FilePath As String, ByVal FileName As String)
    
      Dim objFolder As Object
      Dim objFolderItem As Object
      Dim objShell As Object
    
        FileName = StrConv(FileName, vbUnicode)
        FilePath = StrConv(FilePath, vbUnicode)
    
         Set objShell = CreateObject("Shell.Application")
         Set objFolder = objShell.Namespace(StrConv(FilePath, vbFromUnicode))
         
           If Not objFolder Is Nothing Then
             Set objFolderItem = objFolder.ParseName(StrConv(FileName, vbFromUnicode))
           End If
           
           If Not objFolderItem Is Nothing Then
             GetFileOwner = objFolder.GetDetailsOf(objFolderItem, 8)
           Else
             GetFileOwner = ""
           End If
           
         Set objShell = Nothing
         Set objFolder = Nothing
         Set objFolderItem = Nothing
         
    End Function
    
    Sub CommandButton2_Click()
        ' BrowseForFolder
    
    Dim dirInfo As BROWSEINFO
    Dim path As String
    Dim r As Long, x As Long, pos As Integer
    
    ' Set Default Root folder = Desktop
    dirInfo.pidlRoot = 0&
    
    dirInfo.lpszTitle = "Browse directory!"
    
    ' Type of directory
    dirInfo.ulFlags = &H1
    
    ' Show the Browse Dialog
    x = SHBrowseForFolder(dirInfo)
    
    ' Parse the result
    path = Space$(512)
    r = SHGetPathFromIDList(ByVal x, ByVal path)
    
    If r Then
        pos = InStr(path, Chr$(0))
        TextBox1 = Left(path, pos - 1)
    Else
        MsgBox "Browse a Directory..."
        CommandButton2_Click
    End If
    
    End Sub
    Attached Files Attached Files
    Last edited by Leith Ross; 08-15-2019 at 02:38 PM.

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Macro to import CSV file with date notation converted
    By Gielekes in forum Excel Programming / VBA / Macros
    Replies: 40
    Last Post: 01-15-2019, 09:16 AM
  2. [SOLVED] Macro that copies workseet into new book saves as broken unless converted first
    By Ozman89 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 05-03-2016, 01:28 PM
  3. How to read cells values from a converted to excel (converted to exe file)
    By AttalaEA in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 08-04-2014, 02:57 AM
  4. Replies: 1
    Last Post: 10-14-2011, 09:27 AM
  5. Excel 2003 Macro Converted to Excel 2007 Outputs Hugely Bloated File
    By IanWF in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 02-08-2011, 01:14 PM
  6. [SOLVED] Numbers 0000 will = 0 when converted to a csv file via macro
    By Mintz87 in forum Excel Programming / VBA / Macros
    Replies: 4
    Last Post: 03-29-2005, 12:06 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1