Improve company productivity with a Business Account.Sign Up

  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 531
  • Last Modified:

Search Through Excel Sheet Using VBScript

Hello Experts.  I have the following question:

I have a list of about 300 folders in Excel spreadsheet.  When I go to that directory, there are actually 550 folders in the directory. I need to compare the folders in the directory with those in Excel sheet to determine which folders are extra.  I am fairly confident with VBScript, but I don't know what properties (or objects) the Excel.Application has and how to use them.

In Excel file I have three sheets each with a listing of files that are in a specific directory. I don't know how to go to a specific sheet to do the search.  Can anyone help?
  • 3
1 Solution
Hi Dmitry,

You can take a look at the sample here from a prvious answer

basically you can reuse the code, i can prepare a sample specific to your situation....

but these steps could give you a go, this was only a complete file lookup in excel, the comaprison could be done with a vlookup

-open a new workbook
-place two buttons on sheet1
-open the VB Editor with ALT+F11
-paste this code under the sheet1 icon

Option Explicit

Private Sub CommandButton1_Click()
 Call Start
End Sub

Private Sub CommandButton2_Click()
 Call ClearSheet
End Sub

-choose insert new module
-then paste this code in the new module

Option Explicit

Public writerow As Integer 'on top of module

Public Sub Start()
 Dim GetDirName As String

On Error GoTo errhandle
 writerow = ActiveCell.Row
 GetDirName = Application.GetOpenFilename ' get filepath from user
 GetDirName = SplitPath(GetDirName, 3)    ' extract drive + path from filepath
 If Len(GetDirName) > 0 Then
 Application.ScreenUpdating = False
     GetFilesInDirectory GetDirName
     LookForDirectories (GetDirName)
     Application.StatusBar = False
 Application.ScreenUpdating = True
 End If
 Exit Sub
 MsgBox "An error has occurred with name " & Err.Description & " and number " & Err.Number
 Exit Sub
End Sub

Public Sub ClearSheet()
 Worksheets(1).Range(Selection, Selection.End(xlDown)).Select
End Sub

Sub LookForDirectories(ByVal DirToSearch As String)
 Dim counter As Integer
 Dim i As Integer
 Dim Directories() As String
 Dim Contents As String
 counter = 0
 DirToSearch = DirToSearch & "\"
 Contents = Dir(DirToSearch, vbDirectory)
 Do While Contents <> ""
     If Contents <> "." And Contents <> ".." Then
         If (GetAttr(DirToSearch & Contents) And vbDirectory) = _
         vbDirectory Then
             counter% = counter% + 1
             ReDim Preserve Directories(counter)
             Directories(counter) = DirToSearch & Contents
         End If
     End If
     Contents = Dir()
 If counter = 0 Then Exit Sub
 For i = 1 To counter
     GetFilesInDirectory Directories(i)
     LookForDirectories Directories(i)
 Next i
End Sub

Sub GetFilesInDirectory(ByVal DirToSearch As String)
 Dim NextFile As String
     ActiveSheet.Cells(writerow, 1).Value = DirToSearch
     writerow = writerow + 1
 NextFile = Dir(DirToSearch & "\" & "*.*")
 Do Until NextFile = ""
     Application.StatusBar = writerow & "  " _
     & DirToSearch & "\" & NextFile
     ActiveSheet.Cells(writerow, 1).Value = _
     ActiveSheet.Cells(writerow, 2).Value = _
     DirToSearch & "\" & NextFile
     ActiveSheet.Cells(writerow, 3).Value = _
     Mid(NextFile, InStr(NextFile, ".") + 1)
     ActiveSheet.Cells(writerow, 4).Value = _
     FileDateTime(DirToSearch & "\" & NextFile)
     ActiveSheet.Cells(writerow, 5).Value = _
     FileLen(DirToSearch & "\" & NextFile) ' Returns file length (bytes).
     writerow = writerow + 1
     NextFile = Dir()
End Sub

Public Function SplitPath(ByVal Path As String, ReturnType As Integer) As String
Dim Drv, DirPath, File, Ext As String
Dim PathLength, Offset, ThisLength As Integer
Dim FileFound As Boolean
Drv = "": DirPath = "": File = "": Ext = ""
If Mid(Path, 2, 1) = ":" Then
  Drv = Left(Path, 2)
  Path = Mid(Path, 3)
End If
PathLength = Len(Path)
For Offset = PathLength To 1 Step -1
  Select Case Mid(Path, Offset, 1)
    Case ".":
      ThisLength = Len(Path) - Offset
      If ThisLength >= 1 And ThisLength <= 3 Then
        Ext = Mid(Path, Offset, ThisLength + 1)
      End If
      Path = Left(Path, Offset - 1)
    Case "\":
      ThisLength = Len(Path) - Offset
      If ThisLength >= 1 And ThisLength <= 40 Then
        File = Mid$(Path, Offset + 1, ThisLength)
        Path = Left(Path, Offset)
        DirPath = Path
        FileFound = True
        Exit For
      End If
    Case Else
  End Select
Next Offset
SplitPath = Drv & Path & File & Ext
Select Case ReturnType
  Case 1: SplitPath = Drv
  Case 2: SplitPath = Path
  Case 3: SplitPath = Drv & Path
  Case 4: SplitPath = File
  Case 5: SplitPath = File & Ext
  Case 6: SplitPath = Ext
End Select
End Function

-close and save and have fun

Richie_SimonettiIT OperationsCommented:
Hi bruintje, let something to the others!!!
sorry...but msoffice is to quiet and all office q's end up here :)
DmitriyAuthor Commented:
Thanx for fast responce, bruintje.  I haven't had a chance to test the answer yet.  My friend helped me out with VB macro to the excel spreadsheet.  It works perfectly.

However, since you provided such a detailed answer, I will use it for my future refference.

thanks for the grade, and certainly check that last function to split dir/path/file something i found a few weeks back and is certainly a smart piece to use in future situations

thanks again
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Upgrade your Question Security!

Your question, your audience. Choose who sees your identity—and your question—with question security.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now