Does anybody have a free, malware-free application that can crack PST files, an employee im providing support for forgot their password for their pst file.
Let me know!
Let me know!

This section allows you to view all posts made by this member. Note that you can only see posts made in areas you currently have access to.
Show posts Menu
Private Sub UserForm_Initialize()
'Dim wdApp As Word.Application
'Set wdApp = New Word.Application
Dim subfolders As Boolean
Dim MyPath As String
Dim MyPath2 As String
Dim MyPath3 As String
Dim MyPath4 As String
Dim MyPath5 As String
Dim MyName As String
subfolders = False
MyPath = variables.formspath
MyPath2 = variables.formspath & "ACU Forms"
MyPath3 = variables.formspath & "Directors Office"
MyPath4 = variables.formspath & "Insolvency"
MyPath5 = variables.formspath & "Revenue"
'strip quotation marks from path
If Len(MyPath) = 0 Then Exit Sub
'If Asc(MyPath) = 34 Then
'MyPath = Mid$(MyPath, 2, Len(MyPath) - 2)
'End If
'========== Page 1 ====================
'get files from the selected folder path
'and insert them into the select ListBox
'MyName = Dir$(MyPath & "*.*")
CustomFindFile "*.dot", MyPath, False, 1
'========== Page 2 ====================
CustomFindFile "*.dot", MyPath2, False, 2
'========== Page 3 ====================
CustomFindFile "*.dot", MyPath3, False, 3
'========== Page 4 ====================
CustomFindFile "*.dot", MyPath4, True, 4
'========== Page 5 ====================
CustomFindFile "*.dot", MyPath5, True, 5
End Sub
'==========
Function CustomFindFile(strFileSpec As String, path As String, recursive As Boolean, vList As Integer)
Dim fsoFileSearch As FileSearch
Dim i As Integer, j As Integer
Dim insert As Boolean
Dim aSize As Long
Dim bsize As Long
Dim formFiles0() As String 'filenames
Dim formFiles1() As String 'fullpath filenames
Dim k As Integer
k = 0
ClearFindAndReplaceParameters
Set fsoFileSearch = Application.FileSearch
With fsoFileSearch
.NewSearch
.LookIn = path
.filename = strFileSpec
.SearchSubFolders = recursive
If .Execute() > 0 Then
ReDim formFiles0(1 To .FoundFiles.count)
ReDim formFiles1(1 To .FoundFiles.count)
'assign found files to an array
For i = 1 To .FoundFiles.count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(.FoundFiles(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = .FoundFiles(i)
formFiles0(k) = Dir(.FoundFiles(i), vbDirectory)
End If
Next i
'assign files to correpsonding page list
'================== Page 1 - Operations - LIST
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
'================== Page 2 - ACU - LIST
ElseIf vList = 2 Then
aSize = UniquifyStringArray(formFiles0, pg2FormFiles0)
pg2FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList2.AddItem pg2FormFiles0(i)
Next i
'================== Page 3 - AM - LIST
ElseIf vList = 3 Then
aSize = UniquifyStringArray(formFiles0, pg3FormFiles0)
pg3FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList3.AddItem pg3FormFiles0(i)
Next i
'================== Page 4 - Insolvency - LIST
ElseIf vList = 4 Then
aSize = UniquifyStringArray(formFiles0, pg4FormFiles0)
pg4FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList4.AddItem pg4FormFiles0(i)
Next i
ElseIf vList = 5 Then
aSize = UniquifyStringArray(formFiles0, pg5FormFiles0)
pg5FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList5.AddItem pg5FormFiles0(i)
Next i
End If
End If
End With
'MsgBox strFileList
End Function
Function UniquifyStringArray(ByRef InputArray() As String, _
ByRef UniqueArray() As String) As Long
Dim C As New Collection
Dim i As Long
On Error Resume Next
For i = LBound(InputArray) To UBound(InputArray)
C.Add InputArray(i), InputArray(i)
Next
ReDim UniqueArray(1 To C.count)
For i = 1 To C.count
UniqueArray(i) = C(i)
Next
UniquifyStringArray = C.count
Set C = Nothing
End Function
Function CustomFindFile(strFileSpec As String, path As String, recursive As Boolean, vList As Integer)
Dim fso As New FileSystemObject
Dim folder, files
Dim fileArray(1000) As String
Dim folderIdx As Variant
Dim i As Integer, j As Integer, m As Integer
Dim count As Integer
Dim insert As Boolean
Dim aSize As Long
Dim bsize As Long
Dim formFiles0() As String 'filenames
Dim formFiles1() As String 'fullpath filenames
Dim k As Integer
k = 0
count = 1
ClearFindAndReplaceParameters
'With fsoFileSearch
'.NewSearch
'.LookIn = path
'.filename = strFileSpec
'.SearchSubFolders = recursive
'If .Execute() > 0 Then
Set folder = fso.GetFolder(path)
Set files = folder.files
For Each folderIdx In files
fileArray(count) = folderIdx.name
count = count + 1
Next
ReDim formFiles0(1 To count)
ReDim formFiles1(1 To count)
'assign found files to an array
For i = 1 To count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(fileArray(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = fileArray(i)
Debug.Print "testing!"
' skips over next debug.print... WHY?
Debug.Print fileArray(i)
formFiles0(k) = Dir(fileArray(i), vbDirectory)
End If
Next i
Debug.Print "Made it to here!"
'assign files to correpsonding page list
'================== Page 1 - Operations - LIST
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
'================== Page 2 - ACU - LIST
ElseIf vList = 2 Then
aSize = UniquifyStringArray(formFiles0, pg2FormFiles0)
pg2FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList2.AddItem pg2FormFiles0(i)
Next i
'================== Page 3 - AM - LIST
ElseIf vList = 3 Then
aSize = UniquifyStringArray(formFiles0, pg3FormFiles0)
pg3FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList3.AddItem pg3FormFiles0(i)
Next i
'================== Page 4 - Insolvency - LIST
ElseIf vList = 4 Then
aSize = UniquifyStringArray(formFiles0, pg4FormFiles0)
pg4FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList4.AddItem pg4FormFiles0(i)
Next i
ElseIf vList = 5 Then
aSize = UniquifyStringArray(formFiles0, pg5FormFiles0)
pg5FormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList5.AddItem pg5FormFiles0(i)
Next i
End If
'MsgBox strFileList
End Function
If vList = 1 Then
'remove duplicates from array of filenames
aSize = UniquifyStringArray(formFiles0, uFormFiles0)
uFormFiles1 = formFiles1
For i = 1 To aSize
select_userForm.lstFileList.AddItem uFormFiles0(i)
Next i
'With fsoFileSearch
'.NewSearch
'.LookIn = path
'.filename = strFileSpec
'.SearchSubFolders = recursive
'If .Execute() > 0 Then
Set folder = fso.GetFolder(path)
Set files = folder.files
For Each folderIdx In files
fileArray(count) = folderIdx.name
count = count + 1
debug.print fileArray(count)
Next
ReDim formFiles0(1 To count)
ReDim formFiles1(1 To count)
'assign found files to an array
For i = 1 To count
'strFileList = strFileList & Dir(.foundfile(i), vbDirectory) & vbCrLf
'lstFileList.AddItem Dir(.FoundFiles(i), vbDirectory)
If Dir(fileArray(i), vbDirectory) <> "" Then
k = k + 1
formFiles1(k) = fileArray(i)
Debug.Print "testing!"
' skips over next debug.print... WHY? (doesn't print variable name)
Debug.Print fileArray(i)
formFiles0(k) = Dir(fileArray(i), vbDirectory)
End If
Next i
Debug.Print "Made it to here!"
Page created in 0.059 seconds with 13 queries.