2008年6月2日 星期一

VBA---Main

Option Explicit
Public Function toStart(ByVal fileType As String) As String
Dim openFilesWorker As OpenAllFiles
Set openFilesWorker = New OpenAllFiles
Dim filesListSize As Long

Dim BrowseFolder As FileDialog
Set BrowseFolder = Application.FileDialog(msoFileDialogFolderPicker)
Dim folderPath


Dim toFormat

Dim saveFilesWorker As Save
Set saveFilesWorker = New Save

Dim toSaveAll As Boolean
Dim Prefix
Dim fileExtensionafterCon As String
Dim counter As Integer
Dim errSaveCounter As Integer
Dim succSaveCounter As Integer

Dim branches As Variant

Dim isCat

'initialization of the variables
counter = 0
errSaveCounter = 0
succSaveCounter = 0
fileExtensionafterCon = "doc"

isCat = MsgBox("Your files is catagorized?", vbYesNoCancel, "Check if files Prepared")

If (isCat = 6) Then
'folderPath = InputBox("Please enter of the file name", "File name of " & fileType, "", 100, 1)

With BrowseFolder
.Show
If BrowseFolder.SelectedItems.Count > 0 Then
folderPath = .SelectedItems(1)
End If
End With


'1. Open File'''''''''''''''''''''''''''''''
' Make sure strDirPath is a directory.
'Ignore errors to allow for error evaluation
If (folderPath <> "") And IsFileOrDirExists(folderPath) Then

filesListSize = openFilesWorker.GetAllFiles(folderPath)

On Error Resume Next

If fileType = "MIS" Then
Dim fileTypePrefix
fileTypePrefix = InputBox("Please enter the prefix of the file name. If you choose not to enter it , your document will be named with no prefix (e.g. _XXX.doc)", "Prefix of file request", "Mis")

Dim orientalworker As orientalChosenForm
Set orientalworker = New orientalChosenForm

Dim oriental As String
oriental = 1 ' default value is landscape


oriental = orientalworker.Ori

End If
For counter = 0 To filesListSize
'******************************************************************************************
'Operation after open the file and b4 saving***********************************************
'******************************************************************************************
'2. Format'''''''''''''''''''''''''''''''
If fileType = "MIS" And fileTypePrefix <> "" Then
branches = fileTypeChoice(fileType, fileTypePrefix, oriental)
Prefix = branches(0)

Else
branches = fileTypeChoice(fileType)
Prefix = branches(0)

End If

Prefix = "\" & Prefix & "_"
'******************************************************************************************
'3. Save and Close'''''''''''''''''''''''''''''''

toSaveAll = saveFilesWorker.toSave(Prefix, fileExtensionafterCon)

Select Case toSaveAll
Case Is = 1
succSaveCounter = succSaveCounter + 1
Case Else
errSaveCounter = errSaveCounter + 1
If Err.Number <> 0 Then
MsgBox Err.Number & Err.Description, vbMsgBoxHelpButton, "Error Encountered", Err.HelpFile
End If

End Select

Next counter
MsgBox "No. of files successfully Converted: " & succSaveCounter & vbCrLf & "No. of files fail Converted: " & errSaveCounter & vbCrLf, vbInformation, "Result"

Else
MsgBox "No files Converted!!!", vbInformation, "No files converted notice"
End If
ElseIf (isCat = 7) Then
On Error Resume Next
branches = fileTypeChoice(fileType)

Select Case Err.Number
Case Is = 0

Prefix = branches(0)
Prefix = "\" & Prefix & "_"
toSaveAll = saveFilesWorker.toSave(Prefix, fileExtensionafterCon)


Case Else
Select Case VBA.MsgBox("Do you want to open a single File?", vbOKCancel, "Active document exists checking")
Case VBA.vbOK
Dim BrowseFile As FileDialog
Set BrowseFile = Application.FileDialog(msoFileDialogFilePicker)
Dim choosenFileList As Variant

Dim openSingleFile As Boolean
Dim openSingleFileWorker As OpenAllFiles



With BrowseFile
.Filters.Clear
.InitialFileName = "C:\Documents and Settings\hmdleung\Desktop\excel_rpt_trial"
.InitialView = msoFileDialogViewDetails
.Filters.Add "All out Files", "*.out"
.Filters.Add "All Files", "*.*"
.AllowMultiSelect = False
.Title = .SelectedItems(1)


If .Show Then
For Each choosenFileList In .SelectedItems
openSingleFile = openSingleFileWorker.openSingleFile(choosenFileList)

branches = fileTypeChoice(fileType)

Prefix = branches(0)
Prefix = "\" & Prefix & "_"
toSaveAll = saveFilesWorker.toSave(Prefix, fileExtensionafterCon)

Next
End If
End With
Case VBA.vbCancel
MsgBox "No files converted", vbCritical, "File not chosen"
End Select


End Select
Else
MsgBox "You have cancelled your action!", vbExclamation, "Cancel Action"
End If

End Function
Public Function IsFileOrDirExists(ByVal PathName As String) As Boolean
'Macro Purpose: Function returns TRUE if the specified file
' or folder exists, false if not.
'PathName : Supports Windows mapped drives or UNC
' : Supports Macintosh paths
'File usage : Provide full file path and extension
'Folder usage : Provide full folder path
' Accepts with/without trailing "\" (Windows)
' Accepts with/without trailing ":" (Macintosh)

Dim iTemp As Integer

'Ignore errors to allow for error evaluation
On Error Resume Next
iTemp = GetAttr(PathName)

'Check if error exists and set response appropriately
Select Case Err.Number
Case Is = 0
IsFileOrDirExists = True
Case Else
IsFileOrDirExists = False
End Select

'Resume error checking
On Error GoTo 0
End Function
Public Function fileTypeChoice(ByVal fileType As String, Optional ByVal fileNamePrefix As String, Optional ByVal orientation As Integer) As Variant

Dim formatFilesWorker As Format
Set formatFilesWorker = New Format

Dim tempArray(2) As Variant

Select Case fileType
Case "TB"
tempArray(0) = "Trial_Balance"
tempArray(1) = formatFilesWorker.PortraitFormat()
Case "GL"
tempArray(0) = "General_Ledger"
tempArray(1) = formatFilesWorker.LandscapeFormat()
Case "PL"
tempArray(0) = "P&L"
tempArray(1) = formatFilesWorker.LandscapeFormat()
Case "BS"
tempArray(0) = "BS"
tempArray(1) = formatFilesWorker.LandscapeFormat()
Case "UJ"
tempArray(0) = "Unposted Journals"
tempArray(1) = formatFilesWorker.LandscapeFormat()

Case Else
tempArray(0) = fileNamePrefix

If (orientation = 0) Then
tempArray(1) = formatFilesWorker.PortraitFormat()
Else
tempArray(1) = formatFilesWorker.LandscapeFormat()
End If

End Select

fileTypeChoice = tempArray

End Function

沒有留言: