Results 1 to 6 of 6
  1. #1
    Join Date
    Feb 2004

    Exclamation Unanswered: VB code running on one PC not others

    I have compiled a VB code, borrowing some, adding some. It's intended purpose is to get information about all files in a directory/disk. Originally I used the the msoFileTypeAll, until I read that it did not always pick up .zip's as files vs folders.

    I added a new section to pick up zip files in another fashion. On my machine it worked perfectly. Went through all the sub folders, picked up all files, relooped, picked up all .zip files.

    Moved it to another machine, suddenly, it picks up all files in main and subfolders of all types except .zip. It DOES pick up the first .zip file in the main folder, but no others, and ignores all .zips in sub-folders.

    I compared the machines piece by piece, XP version, Office version, VB version, even the winzip version out of desperation. All the folder securities even. I am at a total loss. If anyone could please help, I would be eternally grateful. This is running on Office XO, thru an Excel Macro (Version 2003 SP2) with VB 6.3. Please excuse all the commenting out (Leftovers from trying to resolve the original problem)

    Sub PopulateDirectoryList()
    '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
    Dim InputDisc As String, InputMainFolder As String, InputSubFolder As String
    Dim fso, fldr, f 'REMOVE

    ToggleStuff False 'turn of screenupdating

    Set objFSO = New FileSystemObject 'set a new object in memory
    Set fso = CreateObject("Scripting.FileSystemObject") ' REMOVE
    strSourceFolder = BrowseForFolder 'call up the browse for folder routine
    If strSourceFolder = "" Then Exit Sub

    'Workbooks.Add 'create a new workbook

    Set wbNew = ActiveWorkbook
    Set wsNew = wbNew.Sheets(1) 'set the worksheet
    'format a header
    With wsNew.Range("A1:H1")
    .Value = Array("File", "Size", "Modified Date", "Created Date", "Full Path", "Disc Name", _
    "Main Folder", "Sub Folder")
    .Interior.ColorIndex = 4
    .Font.Bold = True
    .Font.Size = 8
    End With
    With wsNew.Range("A2:H60000")
    .Font.Size = 8
    End With

    With Application.FileSearch
    .LookIn = strSourceFolder 'look in the folder browsed to
    .Filename = "*.*" 'get all files
    .SearchSubFolders = True 'search sub directories
    .Execute 'run the search

    'create InputBox
    InputDisc = InputBox("Enter Disc Name: ", "Disc Name", "Disc ")
    InputMainFolder = InputBox("Enter Main Folder: ", "Main Folder Name")
    InputSubFolder = InputBox("Enter Sub Folder: ", "Sub Folder Name")

    'Set objFSO = New FileSystemObject 'set a new object in memory
    'strSourceFolder = BrowseForFolder

    'Set objFolder = objFSO.GetFolder(strSourceFolder) 'get the folder
    'x = 0
    'For Each objFile In objFolder.Files
    'rngDir.Offset(x, 0) = strSourceFolder
    'rngDir.Offset(x, 1) = objFile.Name
    'x = x + 1
    'Next objFile

    'Set objFolder = Nothing
    'Set objFile = Nothing
    'Set objFSO = Nothing

    Set fldr = fso.GetFolder(strSourceFolder)
    x = 0 'remove
    For Each f In fldr.Files
    If Right(f.Name, 4) = ".zip" Then
    'MsgBox f.Name
    With wsNew.Cells(2, 1) 'populate the next row with the variable data
    .Offset(i, 0) = f.Name
    .Offset(i, 1) = Format(f.Size, "0,000") & " KB"
    .Offset(i, 2) = f.DateLastModified
    .Offset(i, 3) = f.DateCreated
    .Offset(i, 4) = f.Path
    .Offset(i, 5) = InputDisc
    .Offset(i, 6) = InputMainFolder
    .Offset(i, 7) = InputSubFolder
    End With
    End If
    x = x + 1
    Set f = Nothing

    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:H1")
    .Value = Array("File", "Parent Folder", "Full Path", "Modified Date", _
    .Interior.ColorIndex = 4
    .Font.Bold = True
    .Font.Size = 8
    End With
    With wsNew.Range("A2:H7")
    .Font.Size = 8
    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(2, 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.DateCreated
    .Offset(i, 4) = objFile.Path
    .Offset(i, 5) = InputDisc
    .Offset(i, 6) = InputMainFolder
    .Offset(i, 7) = InputSubFolder

    End With
    ' Next objFile
    'this is in case a Permission denied error comes up or an unforeseen error
    'Do nothing, just go to next file
    Next x

    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
    End Sub
    Sub ToggleStuff(ByVal x As Boolean)
    Application.ScreenUpdating = x
    Application.EnableEvents = x
    End Sub

    Function BrowseForFolder(Optional OpenAt As Variant) As Variant

    Dim ShellApp As Object
    Set ShellApp = CreateObject("Shell.Application"). _
    BrowseForFolder(0, "Please choose a folder", 0, OpenAt)

    On Error Resume Next
    BrowseForFolder = ShellApp.self.Path
    On Error GoTo 0

    Set ShellApp = Nothing

    Select Case Mid(BrowseForFolder, 2, 1)
    Case Is = ":"
    If Left(BrowseForFolder, 1) = ":" Then GoTo Invalid
    Case Is = "\"
    If Not Left(BrowseForFolder, 1) = "\" Then GoTo Invalid
    Case Else
    GoTo Invalid
    End Select
    Exit Function


    ToggleStuff True
    End Function

  2. #2
    Join Date
    Jun 2004
    Arizona, USA
    It sounds as if you're distributing the app simply by copying the exe from one machine to another. Your app probably has dependencies which are present on the development machine, but not on the others.

    Build an install package, which will contain all the dependencies that your app requires, and which will register them on the target machine.

    VB's Package & Deployment wizard often does an acceptable job, but it has its warts. Personally, I use VSI (Visual Studio Installer) which is a free download from microsoft, if you own the professional or enterprise editions of VB or Visual Studio.
    "Lisa, in this house, we obey the laws of thermodynamics!" - Homer Simpson
    "I have my standards. They may be low, but I have them!" - Bette Middler
    "It's a book about a Spanish guy named Manual. You should read it." - Dilbert

  3. #3
    Join Date
    Feb 2004

    Using as excel macro

    Thanks for your response. I am actually using this in an Excel Macro. Would your suggestions still apply in that case?

  4. #4
    Join Date
    Jan 2007
    Provided Answers: 12
    Excel uses VBA; not VB - I suggest you check the references when in the code window (Tools > References) on both machines and compare.
    Home | Blog

  5. #5
    Join Date
    Feb 2004
    Thanks, I probably should have put that Or see if there is a VBA forum instead. I definitely checked the references first, they have the same and are in the same priority level as well. Sorry I mean tto put that too, but must have missed it as it was such a long post! Thanks for the suggestion tho

  6. #6
    Join Date
    Jan 2007
    Provided Answers: 12
    There's even an Excel forum
    I suggest you stick a handful of messageboxes throughout the code and just see if one doesn't fire (simple debugging, eh?)
    MsgBox "1"
    MsgBox "2"
    Can't really suggest much more than that at the moment. It just sounds like a loop isn't triggering properly - debug to narrow down the problem.
    Home | Blog

Posting Permissions

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