Urgent Please! VBA Module Algorithm(?) Code Extremely Large

R

rebelscum0000

Dear All

My Problem began when I have to Writing out .txt files using
FreeFile(), in
different paths, when I select from my browse dialog in which Path I
want to write these files

Is not the same when I select C:\ (<Drive>: \)

Code: 'GetFolder & strDrive & " Temp" & ".CRC"
Result: C:\C Temp.CRC
Code : 'GetFolder & strDrive & " Report" & ".txt"
Result: C:\C Report.txt

than when I select C:\DVD APPZ X (<Drive>:\Folder)
Result:
Code: 'GetFolder & "\" & MidPathGetFolder & " Temp" & ".CRC"
Result:C:\DVD APPZ X\DVD APPZ X Temp.CRC
'Code: 'GetFolder & "\" & MidPathGetFolder & " Report" & ".txt"
Result: C:\DVD APPZ X\DVD APPZ X Report.txt

Or Finally When I select
C:\DVD APPZ X\Appz HD\Iomega\Trouble in Paradise\Info
(<Drive>:\Folder\Folder.....)
Code:'GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Temp" & ".CRC"
(First Folder Name TO LastFolder Name File.Extension)
Result:C:\DVD APPZ X\Appz HD\Iomega\Trouble in Paradise\Info\C DVD
APPZ X TO Info Temp.CRC
Code: 'GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Report" & ".txt"
(First Folder Name TO LastFolder Name File.Extension)
Result: C:\DVD APPZ X\Appz HD\Iomega\Trouble in Paradise\Info\C DVD
APPZ X TO Info Report.txt

In order to have these "Results" I have to repeat the SAME part of the
code OFTEN (3 to be exact) making my code EXTREMELY large

I know the logic of my code is not right, So I need to re-write before
the code begin to grow too much

I asked and someone told me

"One way of reusing code is to create functions"

Can someone please explain me how "reusing" code creating functions?

Or if is another way to do this, any help is more than welcome

Thanks in advance
Regards,
Antonio Macias

This is my entire code:

Sub OpenWinBrowse()

Dim MyDlg As New DialogClass 'Common Dialogs Class Module for Access
and VBA
Dim MyDialogResponse As Integer
Dim GetFolder As String
Dim LenGetFolder As Integer
Dim MyGetFolder As String
Dim MidPathGetFolder As String
Dim PosFirstFolder As Integer
Dim LeftFirstFolder As String
Dim PosLastFolder As Integer
Dim FirstLastFolderDif As Integer
Dim LeftLastFolder As String
Dim strDrive As String
Dim ccgFF As Integer
Dim egfFF As Integer


'On Error GoTo ErrorHandling
'GoTo Replace_First_Process:
'GoTo Replace_Second_Process:
'GoTo Fix_FileExtensions:

'Start Event Open_Windows_Browse
'Opens the Browse Dialog
With MyDlg
..TypeFile = 0 'All file Types
..TypeFile = 4 'Text Files
..DialogType = "Browse"
End With
'Show the select type of dialog selected with the properties desired
MyDlg.Show

'Waits for the user to click a button, and returns an Integer
indicating which button
'the user clicked .DialogType = "Browse"
MyDialogResponse = Len(MyDlg.ReturnFilePath)

if MyDialogResponse = 0 Then
'User chose Cancel.
MsgBox "User Cancelled", vbExclamation, "Browse"
End
Else
'User Chose OK.
Debug.Print "My Dir Selected " & MyDialogResponse
End If

'The name for the chosen file or directory
'<Drive>:\Folder
GetFolder = MyDlg.ReturnFilePath
Debug.Print "GetFolder = " & GetFolder
LenGetFolder = Len(GetFolder)
Debug.Print "LenGetFolder = " & LenGetFolder
Determine IF is <Drive>:\ OR <Drive>:\Folder OR <Drive>:\Folder\Folder
MyGetFolder = InStr(4, GetFolder, "\")
Debug.Print "MyGetFolder = " & MyGetFolder
'Folder
MidPathGetFolder = Mid(GetFolder, 4, LenGetFolder)
Debug.Print "MidPathGetFolder = " & MidPathGetFolder
'<Drive>
strDrive = Left(GetFolder, 1)

'Start Event CodeSelection_Drive_Folders
'Determine IF is <Drive>:\ OR <Drive>:\Folder OR <Drive>:\Folder
\Folder
If LenGetFolder = 3 And MyGetFolder = 0 And MidPathGetFolder = "" Then
Debug.Print "<Drive>:\"
'Is <Drive>
MyCodeSelection = 1
ElseIf LenGetFolder <> 3 And MyGetFolder = 0 And MidPathGetFolder <>
"" Then
Debug.Print "<Drive>:\Folder"
'Is <Drive>:\Folder
MyCodeSelection = 2
ElseIf MyGetFolder <> 0 And LenGetFolder <> 3 And MidPathGetFolder <>
"" Then
Debug.Print "<Drive>:\Folder\Folder"
'Is <Drive>:\Folder\Folder
MyCodeSelection = 3
End If

Debug.Print "MyCodeSelection = " & MyCodeSelection

'Initialize New Event Copy a File
'FileCopy "C:\Program Files\CDCheck\CDCheck.exe", "C:\WINDOWS\"

'Initialize New Event API_File_Exists
If MyCodeSelection = 1 Then
'Determine IF is <Drive>:\ OR <Drive>:\Folder OR <Drive>:\Folder
\Folder
'Is <Drive>
MsgBox "'Is <Drive>"

If FileExists(GetFolder & strDrive & " Temp" & ".CRC") = True Then
'<Drive>:\<drive letter> Temp.CRC
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Deletes <Drive>:\<drive letter> Temp.CRC
Kill (GetFolder & strDrive & " Temp" & ".CRC")
Debug.Print GetFolder & strDrive & " Temp" & ".CRC"
Else
'File Exists: = False
End If

If FileExists(GetFolder & strDrive & " Report" & ".txt") = True Then
'<Drive>:\<drive letter> Report.txt
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Deletes <Drive>:\<drive letter> Report.txt
Kill (GetFolder & strDrive & " Report" & ".txt")
Debug.Print GetFolder & strDrive & " Report" & ".txt"
Else
'File Exists: = False
End If

ElseIf MyCodeSelection = 2 Then
'Determine IF is <Drive>:\ OR <Drive>:\Folder OR <Drive>:\Folder
\Folder
'Is <Drive>:\Folder
MsgBox "'Is <Drive>:\Folder"

If FileExists(GetFolder & "\" & MidPathGetFolder & " Temp" & ".CRC") =
True Then
'<Drive>:\Folder\FolderName Temp.CRC
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Deletes <Drive>:\Folder\FolderName Temp.CRC
Kill (GetFolder & "\" & MidPathGetFolder & " Temp" & ".CRC")
Debug.Print GetFolder & "\" & MidPathGetFolder & " Temp" & ".CRC"
Else
'File Exists: = False
End If

If FileExists(GetFolder & "\" & MidPathGetFolder & " Report" & ".txt")
= True Then
'<Drive>:\Folder\FolderName Report.txt
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Delete <Drive>:\Folder\FolderName Report.txt
Kill (GetFolder & "\" & MidPathGetFolder & " Report" & ".txt")
Debug.Print GetFolder & "\" & MidPathGetFolder & " Report" & ".txt"
Else
'File Exists: = False
End If

ElseIf MyCodeSelection = 3 Then
'Determine IF is <Drive>:\ OR <Drive>:\Folder OR <Drive>:\Folder
\Folder
'Is <Drive>:\Folder\Folder

'Position of the First "\" Found in MidPathGetFolder
PosFirstFolder = InStr(4, MidPathGetFolder, "\", vbTextCompare)
Debug.Print "PosFirstFolder = " & PosFirstFolder
'First FolderName
LeftFirstFolder = Mid(MidPathGetFolder, 1, PosFirstFolder - 1)
Debug.Print "LeftFirstFolder " & LeftFirstFolder
'Position of the Last "\" Found in MidPathGetFolder
PosLastFolder = InStrRev(MidPathGetFolder, "\", -1, vbTextCompare)
Debug.Print "PosLastFolder = " & PosLastFolder
'Subtraction LenGetFolder - PosLastFolder to get the Len of
LeftLastFolder
FirstLastFolderDif = LenGetFolder - PosLastFolder
Debug.Print "FirstLastFolderDif = " & FirstLastFolderDif
'Last FolderName
LeftLastFolder = Mid(MidPathGetFolder, PosLastFolder + 1,
FirstLastFolderDif)
Debug.Print "LeftLastFolder = " & LeftLastFolder
MsgBox "'Is <Drive>:\Folder\Folder"

If FileExists(GetFolder & "\" & strDrive & " " & LeftFirstFolder & "
TO " & LeftLastFolder & " Temp" & ".CRC") = True Then
'<Drive>:\Folder\Folder Temp.CRC
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Deletes <Drive>:\Folder\Folder Temp.CRC
Kill (GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Temp" & ".CRC")
Debug.Print GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO
" & LeftLastFolder & " Temp" & ".CRC"
Else
'File Exists: = False
End If

If FileExists(GetFolder & "\" & strDrive & " " & LeftFirstFolder & "
TO " & LeftLastFolder & " Report" & ".txt") = True Then
'<Drive>:\Folder\Folder Report.txt
'API FileExists: Returns True of False If a File Exists
'IF FileExists = True Then Kill
'File Exists: = True
'Delete <Drive>:\Folder\Folder Report.txt
Kill (GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Report" & ".txt")
Debug.Print GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO
" & LeftLastFolder & " Report" & ".txt"
Else
'File Exists: = False
End If
End If

'Test Delete
'MsgBox FileExists("C:\DVD APPZ X\Appz Flash\ByteScout\Movies
Extractor Scout\.raidenftpd.acl")

'Initialize New Event Writing_out_Temporal_CRC_File
'Writing out a Temporal .CRC file <Drive>:\Folder\File.CRC
'In order to add this file into the Hash File without user
intervention (Writing out a Temporal batch file)
If MyCodeSelection = 1 Then
'Initialize Variables
ccgFF = FreeFile()
Open GetFolder & strDrive & " Temp" & ".CRC" For Output As #ccgFF
Close #ccgFF ' Close file
ElseIf MyCodeSelection = 2 Then
'Initialize Variables
ccgFF = FreeFile()
Open GetFolder & "\" & MidPathGetFolder & " Temp" & ".CRC" For Output
As #ccgFF
Close #ccgFF ' Close file
ElseIf MyCodeSelection = 3 Then
'Initialize Variables
ccgFF = FreeFile()
Open GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Temp" & ".CRC" For Output As #ccgFF
Close #ccgFF ' Close file
End If

'Initialize New Event Writing_out_Temporal_Report_txt_File
'Writing out a Temporal Report txt file <Drive>:\Folder\File.txt
'In order to add this file into the Hash File without user
intervention (Writing out a Temporal batch file)
'Initialize Variables
If MyCodeSelection = 1 Then
'Initialize Variables
egfFF = FreeFile()
Open GetFolder & strDrive & " Report" & ".txt" For Output As #egfFF
ElseIf MyCodeSelection = 2 Then
'Initialize Variables
egfFF = FreeFile()
Open GetFolder & "\" & MidPathGetFolder & " Report" & ".txt" For
Output As #egfFF
ElseIf MyCodeSelection = 3 Then
'Initialize Variables
egfFF = FreeFile()
Open GetFolder & "\" & strDrive & " " & LeftFirstFolder & " TO " &
LeftLastFolder & " Report" & ".txt" For Output As #egfFF
End If

Print #egfFF, "============ 00/00/0000 00:00:00 AM/PM ============"
Print #egfFF, "-- Results --"
Print #egfFF, "Info"
Print #egfFF, "- date: 00/00/0000"
Print #egfFF, "- process: Hash"
Print #egfFF, "- source: <Drive>:\<Folder>"
Print #egfFF, "- source volume label: Volume Name"
Print #egfFF, ' Write blank line.
Print #egfFF, "Basic statistics"
Print #egfFF, "- time elapsed: 00:00:00"
Print #egfFF, "- overall transfer [kB/s]: 000000000000,000000000000"
Print #egfFF, "- folders processed: 000000000000"
Print #egfFF, "- files processed: 00000000000000"
Print #egfFF, "- source bytes read: 000000000000 MB
(000000000000,000000000000,000000000000 bytes)"
Print #egfFF, "- source average transfer [kB/s]:
000000000000,000000000000"
Print #egfFF, "- source clean transfer [kB/s]:
000000000000,000000000000"
Print #egfFF, ' Write blank line.
Print #egfFF, "Errors"
Print #egfFF, "- errors: 000000000000"
Print #egfFF, "- warnings: 0000000000"
Print #egfFF, "- other: 0000000000000"
Print #egfFF, ' Write blank line.
Print #egfFF, "-- Messages --"
Print #egfFF, "note;hash;Hash file created (code:
0000000000000);<Drive>:\<Folder>:\File.CRC"
Print #egfFF, "note;hash;Hash file created (code:
0000000000000);<Drive>:\<Folder>:\File.CRC"
Print #egfFF, "note;hash;Hash file created (code:
0000000000000);<Drive>:\<Folder>:\File.CRC"
Close #egfFF ' Close file.

'Initialize New Event
API_Folder_Exists_And_CreateDirectory_Nested_Folders
'API Folder Exists
'Checks IF the Folder exists, IF NOT THEN create it
If FolderExists("C:\Program Files\Dups\Batch Files") = True Then
'Folder exists
MsgBox "Folder Exists"
Else
'API CreateDirectory Nested Folders
'Folder does not exist
MsgBox "Folder Does not exits"
newDirectory = "C:\Program Files\Dups\Batch Files"
CreateNestedFoldersByPath (newDirectory)
End If

End Sub
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top