azcomputerguru/claudetools
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
Files
dd5c5afd4b5d4cc5f7bbea719d93f7fcddf675e4
claudetools/projects/dataforth-dos/dfwds-research/source/Release/DFWDS.bas
Mike Swanson dd5c5afd4b Session log + DFWDS Node port + Hoffman API uploader pipeline 
Built the missing piece between the test datasheet pipeline and Dataforth's
new product API. End-to-end:

- Pulled DFWDS (Dataforth Web Datasheet System) VB6 source from
  AD1\Engineering\ENGR\ATE\Test Datasheets\DFWDS to local for analysis
- Decoded its filename validation: A-J prefix decodes (A=10..J=19), all-
  numeric WO# valid (no leading 0), anything else bad
- Ported the validation + move logic to Node (dfwds-process.js)
- Built bulk uploader (upload-delta.js) for Hoffman's Swagger API
  (POST /api/v1/TestReportDataFiles/bulk with OAuth client_credentials)

Sanitized 3 prior reference scripts (fetch-server-inventory, test-scenarios,
test-upload-two) to read CF_* env vars instead of hardcoded creds.

Live drain results:
- 897 files moved Test_Datasheets -> For_Web (all valid, no renames, no
  bad), DFWDS port summary in 1.1s
- Pushed entire For_Web (7,061 files) to Hoffman API in 49.7s @ 142/s:
  Created=803 Updated=114 Unchanged=6,144 Errors=0
- Server count: 489,579 -> 490,382 (+803 net new)

Also:
- Added clients/dataforth/.gitignore to exclude plaintext Oauth.txt note
- Added clients/instrumental-music-center/docs/2026-04-13-ticket-notes.md
  (ticket write-up of 2026-04-11/12/13 IMC1 RDS removal/SQL migration work)

Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
2026-04-14 21:06:50 -07:00

1182 lines
69 KiB
QBasic
Raw Blame History

Attribute VB_Name = "A_Main"
Option Explicit
' -------------------------------------------------------------------------------------------------------------------------------------
' Software for filtering or renaming certain datasheet files for the Dataforth website. "Encoded" datasheet file names of a certain
' format are renamed, while datasheet file names that are invalid for the website are "filtered" by moving them out of the directory
' that is used for datasheets for the website. An external file is used to store the directory names of the main datasheet directory
' and the "filtered" datasheet files directory. The "filtered" files are moved to the "filtered" directory, rather than simply
' deleted, since they are sometimes used for test system debug or qualification.
' -------------------------------------------------------------------------------------------------------------------------------------
'
' The following constant sets the name of the program version that it printed out in the data (CSV file) test report file.
Public Const PROGRAM_NAME = "DFWDS"
Public Const PROGRAM_DESCRIP = "Dataforth Website Datasheet Program"
Public Const PROGRAM_VERSION = "DFWDS_2015_06_08"
' -------------------------------------------------------------------------------------------------------------------------------------
' AUTHORS: Paul Reese
' DATE: 2014/09/29
' EXECUTABLE: DFWDS.exe = Executable program file.
' CODE PROJECT: DFWDS.vbp = Visual Basic project file.
' CODE MODULES: DFWDS.bas = This file, the main code module.
' VB FORMS: frmSplash.frm = Program "splash" form displayed while the program is running.
' -------------------------------------------------------------------------------------------------------------------------------------
'
' -------------------------------------------------------------------------------------------------------------------------------------
' REVISION RECORD
'
' DATE APPR DESCRIPTION
' ---- ---- -----------
' 2014/09/29 PWR Initial version.
' 2014/06/08 PWR Updated to move already-valid and renamed datasheet files to the "web folder" location and
' to properly parse and check "operations" specified in the "names" file.
' NOTE: The operations specified are currently ignored, apart from checking for valid
' operations strings in the "names" file. The program currently always performs
' the equivalent of the "WEBMOVE" operation:
' 1) Move invalid ("bad") files to the specified "INVALID FILE MOVE FOLDER".
' 2) Rename valid DOS-encoded file names and move renamed files to the specified "WEB FOLDER".
' 3) Move already-valid datasheet files to the specified "WEB FOLDER".
'
' -------------------------------------------------------------------------------------------------------------------------------------
'
'Hard-coded "names" file name and location.
Public Const NAMES_FILE_NAME = "DFWDS_NAMES.txt"
'Public Const NAMES_FILE_LOC = "C:\DFWDS"
'Constants used as aliases for code readability.
Public Const DISPLAY_MESSAGES = "True" 'Used, for example, by funcFolderExists to control display of error messages within the routine.
Public Const HIDE_MESSAGES = "False" 'Used, for example, by funcFolderExists to control display of error messages within the routine.
Public Const MOVE_FILE = "True" 'Used, for example, by funcDSmoveRename to control whether the file is moved or renamed.
Public Const RENAME_FILE = "False" 'Used, for example, by funcDSmoveRename to control whether the file is moved or renamed.
'Enumerated constants for the valid operation types.
Private Enum enOperation
OPINVALID = 0 'Invalid operation type (do nothing).
COUNTOP = 1 'Only count the files of various types ("bad", files to rename, valid datasheet files...).
LISTALL = 2 'List the files of various types ("bad", files to rename, valid datasheet files...) in the log file.
LISTBAD = 3 'List only the invalid ("bad") files in the log file.
LISTRENAME = 4 'List only the renamed valid datasheet files in the log file.
INPLACE = 5 'Rename the appropriate files in the same directory they are found.
WEBMOVE = 6 'Move the renamed and already-valid datasheet files to the specified "web move" directory.
End Enum
'
'================================================================================================================================
Sub Main()
' This is the startup (Main) subroutine for the program. Everything starts here.
'
'Define the local variables.
Dim strDSfolderName As String 'Datasheet file folder.
Dim strBadLoc As String 'Invalid ("bad") files are moved to this location in certain operations.
Dim strWebLoc As String 'Web files ("good" and "renamed" files) are moved to this location in certain operations.
Dim strOperation As String 'Operation type (count, list, "in place" or "web move", etc.
Dim strLogFileName As String 'Log file name (only).
Dim strLogFileLoc As String 'Log file folder (only).
Dim strLogFileNameLoc As String 'Log file name and location.
Dim strLogFileLine As String 'Line for the log file.
Dim lCountRenameTotal As Long 'Number of datasheet files to be renamed.
Dim lCountInvalidTotal As Long 'Number of invalid datasheet files to be moved.
Dim lCountRenameGood As Long 'Number of datasheet files renamed that have been moved successfully.
Dim lCountInvalidGood As Long 'Number of invalid datasheet files that have been moved successfully.
Dim lCountAll As Long 'Total number of files in datasheet file directory.
Dim lCountValidTotal As Long 'Number of "good" datasheet files that do not need to be renamed.
Dim lCountValidGood As Long 'Number of "good" datasheet files that have been moved successfully.
Dim iLogFileHandle As Integer 'Log file number ("file handle").
Dim dStartTime As Double 'Program start time.
Dim dEndTime As Double 'Program start time.
Dim strStartDate As String 'Date that the program is run.
Dim iOldMouse As Integer 'Store previous mouse state.
On Error GoTo ErrorHandler
'Display program (splash) form.
frmSplash.Show
frmSplash.Refresh
'Get next valid file number (file
'handle) for the log file.
iLogFileHandle = FreeFile
'Set start time.
dStartTime = Timer
'Initialize counts.
lCountRenameTotal = 0
lCountInvalidTotal = 0
lCountRenameGood = 0
lCountInvalidGood = 0
lCountValidTotal = 0
lCountValidGood = 0
lCountAll = 0
'Check for "names" file and read values from the file. End the
'program if there is a problem with the "names" file.
If Not (functionNamesFileReadOK(strDSfolderName, strLogFileName, strLogFileLoc, strBadLoc, strWebLoc, strOperation) = True) Then
End 'End the program.
End If
'Get starting date of program (for log file name and header)
'and set full log file name based on the formatted date.
strStartDate = Format(Date$, "yyyy_mm_dd") 'Get starting date of program.
strLogFileName = strLogFileName & "_" & strStartDate & ".log" 'Get log file name with date.
'Open log file.
If (funcOpenLogFile(strLogFileName, strLogFileLoc, iLogFileHandle) = False) Then
Close #iLogFileHandle 'Close the log file.
Call subFileOpenMessage(strLogFileNameLoc) 'Display error message.
End 'Exit the program.
End If
'Write log file header.
strLogFileLine = "********************************************************************************"
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = PROGRAM_DESCRIP & " (" & PROGRAM_NAME & "), Version: " & PROGRAM_VERSION & vbCrLf & _
"Date: " & strStartDate & ", Time: " & Time$
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "********************************************************************************"
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
'Call routine to process files in datasheet folder.
Call subProcessDSfolder(strOperation, strDSfolderName, strBadLoc, strWebLoc, strLogFileNameLoc, iLogFileHandle, _
lCountInvalidTotal, lCountRenameTotal, lCountInvalidGood, lCountRenameGood, lCountValidTotal, lCountValidGood, _
lCountAll)
'Write log file footer information and close the log file.
strLogFileLine = "--------------------------------------------------------------------------------"
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "Total files processed = " & lCountAll
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "Bad files to be moved = " & lCountInvalidTotal & vbCrLf & _
"Bad files successfully moved = " & lCountInvalidGood
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "Files to be renamed = " & lCountRenameTotal & vbCrLf & _
"Files successfully renamed = " & lCountRenameGood
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "Valid (unchanged) files = " & (lCountValidTotal) & vbCrLf & _
"Valid files successfully moved = " & (lCountValidGood)
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "Total good datasheet files = " & (lCountValidTotal + lCountRenameTotal) & vbCrLf & _
"Good files successfully moved = " & (lCountValidGood + lCountRenameGood)
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
dEndTime = Timer 'Set end time.
strLogFileLine = "Elapsed time = " & Format(dEndTime - dStartTime, "##0.0") & " seconds"
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
strLogFileLine = "--------------------------------------------------------------------------------"
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
Close #iLogFileHandle
'Unload the program (splash) form.
Unload frmSplash 'Unload the network-copy program splash screen.
End 'Exit program.
Exit Sub ' Exit subroutine (before the error handler) if no error.
ErrorHandler:
Close #iLogFileHandle
MsgBox ("Error in ""Main"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End 'Exit program.
End Sub
Public Function functionNamesFileReadOK(ByRef strDSfolderName As String, ByRef strLogFileName As String, _
ByRef strLogFileLoc As String, ByRef strBadLoc As String, ByRef strWebLoc As String, _
ByRef strOperation As String) As Boolean
'----------------------------------------------------------------------------------------------------
'This function checks for the presence of the "names" file holding the locations of the datasheet
'file folder, the invalid file "move" folder, and the log file folder for the program as well as
'the log file name. If the "names" file is found, this function reads lines from the file and puts
'the values obtained in the appropriate variables that are returned, by reference, for use in other
'routines. The validates the parameter names against the expected names for the appropriate lines
'in the "names" folder, and for the folder values, validates the existence of the folders. The
'function returns "True" if the "names" file is found and the parameter names and values read from
'the names file can be validated against the expected values or the existence of the appropriate
'folders. The function returns "False" if the "names" file cannot be found or read, if any of the
'parameter names or values cannot be validated, or if there is any other problem in the function.
'
'NOTE: The log file name parameter value is validated outside of this function, when the log file
' is first opened.
'
' Inputs:
' All paramters are by-reference outputs whose values are read from the "names" file.
' Outputs:
' Error messages, log file entries.
' Function return: The function returns "True" if the "names" file is found and can be
' read and all of the parameters and values are appropriate.
' strDSfolderName: Passes the name of the datasheet file folder by reference from
' the validated value read from the "names" file.
' strLogFileName: Passes the name of the log file by reference from the validated
' value read from the "names" file.
' strLogFileLoc: Passes the name of the log file folder by reference from the
' validated value read from the "names" file.
' strBadLoc: Passes the name of the invalid ("bad") file folder by reference from
' the validated value read from the "names" file.
' strWebLoc: Passes the name of the "Web" file folder by reference from
' the validated value read from the "names" file.
' strOperation: Passes the name of the operation by reference from
' the validated value read from the "names" file.
'----------------------------------------------------------------------------------------------------
'
'Define the local variables.
Dim strNamesFileLoc As String 'Location (folder) of the "names" file.
Dim strNamesFileNameLoc As String 'Name and location (folder) of the "names" file.
Dim strMessageString As String 'String for error message from reading "names" file lines.
Dim strParmName As String 'Parameter name read from the "names" file.
Dim strParmValue As String 'Parameter value read from the "names" file.
Dim strParmNameExpected As String 'Parameter value expected from the "names" file.
Dim iLineNumber As Integer 'Number of line read from the "names" file.
Dim iNamesFileHandle As Integer 'File number (file "handle") of the "names" file.
Dim objFSO As FileSystemObject 'File system object for "names" file.
On Error GoTo ErrorHandler
'Create an instance of the FileSystemObject (project must reference the
'Windows Scripting Library: Scrrun.dll).
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Get next valid file number (file
'handle) for the "names" file.
iNamesFileHandle = FreeFile
'Initialize.
strMessageString = "" 'Initialize as null (blank) string.
functionNamesFileReadOK = True 'Initialize as "all file entries read OK".
strDSfolderName = "" 'Set string to null.
strLogFileName = "" 'Set string to null.
strLogFileLoc = "" 'Set string to null.
strBadLoc = "" 'Set string to null.
strWebLoc = "" 'Set string to null.
strOperation = "" 'Set string to null.
'Set file name and location from hardcoded constants.
'strNamesFileLoc = NAMES_FILE_LOC 'Set "names" file folder to defined location.
strNamesFileLoc = CurDir 'Set "names" file folder to defined location.
If Right$(strNamesFileLoc, 1) <> "\" Then strNamesFileLoc = strNamesFileLoc & "\" 'Add trailing backslash (if needed).
strNamesFileNameLoc = strNamesFileLoc & NAMES_FILE_NAME 'Add "names" file name to folder.
'Check for existence of "names" file folder.
If Not funcFolderExists(strNamesFileLoc, HIDE_MESSAGES) Then
'Folder not found. Post function error return, display an
'error message (here, not in the "folder exists" function,
'due to the "False" parameter), and exit this function.
functionNamesFileReadOK = False 'Error return value for function.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & vbCrLf & _
"Folder not found: " & strNamesFileLoc & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
Exit Function
End If
'Check for existence of the "names" file.
If Not (objFSO.FileExists(strNamesFileNameLoc)) Then
'File not found. Post error return, display
'error message, and exit function.
functionNamesFileReadOK = False 'Error return value for function.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & vbCrLf & _
"The ""names"" file: " & strNamesFileNameLoc & " was not found!" & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
Exit Function
End If
'Destroy the file system object (it is
'not used later in the function).
Set objFSO = Nothing
'Open the "names" file for input (reading line by line).
Open strNamesFileNameLoc For Input As iNamesFileHandle
'Read lines of the "names" file and check parameter names and values.
For iLineNumber = 1 To 6
'Set expected parameter names.
If (iLineNumber = 1) Then strParmNameExpected = "DATASHEET FOLDER NAME"
If (iLineNumber = 2) Then strParmNameExpected = "INVALID FILE MOVE FOLDER"
If (iLineNumber = 3) Then strParmNameExpected = "LOG FILE NAME"
If (iLineNumber = 4) Then strParmNameExpected = "LOG FILE FOLDER"
If (iLineNumber = 5) Then strParmNameExpected = "WEB FOLDER"
If (iLineNumber = 6) Then strParmNameExpected = "OPERATION"
'Get line of two comma-separated values and put into variables.
Input #iNamesFileHandle, strParmName, strParmValue
'Trim the values read.
strParmName = Trim(strParmName)
strParmValue = Trim(strParmValue)
If (strParmName = strParmNameExpected) Then
'Expected parameter name is found.
If ((iLineNumber = 3) Or (iLineNumber = 6)) Then
'Log file partial name (line 3) or operation type (line 6).
'No modification of parameter is required.
Else
'The parameter is a location (folder) parameter. Add a trailing backslash,
'if necessary, and check if the folder exists.
If Right$(strParmValue, 1) <> "\" Then strParmValue = strParmValue & "\"
'Check if folder exists.
If Not funcFolderExists(strParmValue, HIDE_MESSAGES) Then
'Folder not found. Post function error return, display an
'error message (here, not in the "folder exists" function,
'due to the "False" parameter), and exit this function.
functionNamesFileReadOK = False 'Error return value for function.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & vbCrLf & _
"Folder not found: " & strParmValue & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
Exit Function
End If
End If
Else
'The parameter name read from the "names" file does not match the
'expected value. Post error return, display error message,
'and exit function.
functionNamesFileReadOK = False 'Error return value for function.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & vbCrLf & _
"The parameter read from the ""names"" file" & vbCrLf & _
"does not match the expected value!" & vbCrLf & _
"Parameter read: " & strParmName & vbCrLf & _
"Parameter expected: " & strParmNameExpected & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
Exit Function
End If
'Set parameter values to appropriate variables.
If (iLineNumber = 1) Then strDSfolderName = strParmValue
If (iLineNumber = 2) Then strBadLoc = strParmValue
If (iLineNumber = 3) Then strLogFileName = strParmValue
If (iLineNumber = 4) Then strLogFileLoc = strParmValue
If (iLineNumber = 5) Then strWebLoc = strParmValue
If (iLineNumber = 6) Then strOperation = strParmValue
Next iLineNumber
'Check for valid operation string.
If (funcGetOPnumber(strOperation) = 0) Then
functionNamesFileReadOK = False 'Error return value for function.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & vbCrLf & _
"Invalid operation name =" & strOperation & vbCrLf & _
"No file operations performed!" & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End If
'Close the "names" file.
Close #iNamesFileHandle
Exit Function 'Exit the function (before the error handler) if no error.
ErrorHandler:
Close #iNamesFileHandle 'Close the "names" file.
Set objFSO = Nothing 'Destroy the file system object.
functionNamesFileReadOK = False 'Error return value.
MsgBox ("Error in ""functionNamesFileReadOK"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcOpenLogFile(ByVal strLogFileName As String, ByVal strLogFileLoc As String, _
ByVal iLogFileHandle As Integer) As Boolean
'----------------------------------------------------------------------------------------------------
'This function opens the log file specified by the passed file name and folder for append using the
'passed file "handle". The function returns "True" if there is no problem opening the file, and
'returns "False" if any problem occurs.
'----------------------------------------------------------------------------------------------------
'
'Define the local variables.
Dim strFullFileName As String
On Error GoTo ErrorHandler
'Make sure the folder name includes a trailing "\", then create
'full file name (file name including folder) and open the file
'for append.
If Right$(strLogFileLoc, 1) <> "\" Then strLogFileLoc = strLogFileLoc & "\"
strFullFileName = strLogFileLoc & strLogFileName 'Create full file name (name with location).
Open strFullFileName For Append As iLogFileHandle 'Open log file for append.
funcOpenLogFile = True 'Return value indicating no problems opening the file.
Exit Function ' Exit before error handler.
ErrorHandler:
funcOpenLogFile = False 'Error value.
MsgBox ("Error in ""funcOpenLogFile"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Sub subFileOpenMessage(ByVal strLogFileNameLoc As String)
'----------------------------------------------------------------------------------------------------
'Subroutine to display error message about opening the log file using the passed full log file name
'(the file name complete with its directory location).
'----------------------------------------------------------------------------------------------------
'
MsgBox ("Error opening log file: " & strLogFileNameLoc & " in " & vbCrLf & _
PROGRAM_DESCRIP & " (" & PROGRAM_NAME & "), Version: " & PROGRAM_VERSION & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Sub
Private Function funcFolderExists(ByVal strFolderName As String, ByVal bDisplayErrMsg As Boolean) As Boolean
'----------------------------------------------------------------------------------------------------
'This function returns "True" if the passed folder exists, and "False" if it does not, or there is
'any other problem with the function. The passed flag displays a "file not found" message if "True",
'or skips the message if "false" (for example, if a calling routine has its own error message).
'----------------------------------------------------------------------------------------------------
'
'Define the local variables.
Dim objFSO As FileSystemObject 'File system object for log file.
On Error GoTo ErrorHandler
'Create an instance of the FileSystemObject (project must reference the
'Windows Scripting Library: Scrrun.dll).
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Make sure the folder name includes a trailing "\".
If Right$(strFolderName, 1) <> "\" Then strFolderName = strFolderName & "\"
'Check whether the folder exists.
If Not objFSO.FolderExists(strFolderName) Then
funcFolderExists = False 'Return value for "folder not found".
If (bDisplayErrMsg) Then
'Display error message if the flag is "True".
MsgBox ("Folder not found: " & strFolderName & " in " & vbCrLf & _
PROGRAM_DESCRIP & " (" & PROGRAM_NAME & "), Version: " & PROGRAM_VERSION & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End If
Else
funcFolderExists = True 'Return value for "folder found".
End If
Set objFSO = Nothing 'Destroy file system object.
Exit Function ' Exit before error handler.
ErrorHandler:
funcFolderExists = False 'Error value.
Set objFSO = Nothing 'Destroy file system object.
MsgBox ("Error in ""funcFolderExists"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Sub subProcessDSfolder(ByVal strOperation As String, ByVal strDSfolderName As String, ByVal strDSbadLocation As String, _
ByVal strWebLoc As String, ByVal strDSlogNameLoc As String, ByVal iLogFileHandle As Integer, ByRef lCountInvalidTotal As Long, _
ByRef lCountRenameTotal As Long, ByRef lCountInvalidGood As Long, ByRef lCountRenameGood As Long, _
ByRef lCountValidTotal As Long, ByRef lCountValidGood As Long, ByRef lCountAll As Long)
'-------------------------------------------------------------------------------------------------------------
'Subroutine to process the datasheet (and possibly other) files in the passed folder. The subroutine
'initializes counts, writes a header to the log file specified by the passed log file name and location,
'and performs a directory listing of the passed folder, processing each file name through using
'the "subProcessDSfile" subroutine to determine whether the file is an invalid ("bad") datasheet file.
'Depending on the passed "operation", the subroutine moves the "bad" files to the passed "bad" file
'location, renames and moves the files with valid DOS-encoded datasheet file names to the passed "Web"
'folder, and also moves the files with valid datasheet names that do not need to be renamed to the
'passed "Web" folder. All of these actions (or "list" or "count" operations and/or data) are logged to
'the log file.
'
' Inputs:
' strOperation: Datasheet file operation ("list" or "count" type operations, "in place" rename
' or "web move" for valid and renamed datasheet files).
' strDSfolderName: Source datasheet file folder location.
' strDSbadLocation: Directory location where invalid ("bad") files are moved. Invalid files include
' non-text files and files with names that do not match the format for the Dataforth
' website.
' strWebLoc: Directory location where valid and renamed datasheet files are moved.
' strDSlogNameLoc: Directory location and file name of log file to record datasheet file moves and
' renames.
' iLogFileHandle: File "handle" (file number) for log file.
' lCountInvalidTotal: Passes initial count of invalid ("bad") datasheet files to the
' subroutine. Also used to pass total count back to the calling
' routine for status displays (see entry in "Outputs", below).
' lCountRenameTotal: Passes initial count of renamed datasheet files to the subroutine.
' Also used to pass total count back to the calling routine for status
' displays or log file footer (see entry in "Outputs", below).
' lCountInvalidGood: Passes initial count of invalid ("bad") datasheet files to the
' subroutine. Also used to pass total count back to the calling
' routine for status displays (see entry in "Outputs", below).
' lCountRenameGood: Passes initial count of renamed datasheet files to the subroutine.
' Also used to pass total count back to the calling routine for status
' displays or log file footer (see entry in "Outputs", below).
' lCountValidTotal: Passes initial count of valid datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidGood: Passes initial count of successfully moved valid datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountAll: Passes initial count of all files found in the datasheet folder to
' the subroutine. Also used to pass total count back to the calling
' routine for status displays (see entry in "Outputs", below).
' Outputs:
' Error messages, log file entries.
' lCountInvalidTotal: Passes count of invalid ("bad") datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountRenameTotal: Passes count of DOS-encoded datasheet files found back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountInvalidGood: Passes count of successfully moved invalid ("bad") datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountRenameGood: Passes count of successfully renamed DOS-encoded datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidTotal: Passes count of valid datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidGood: Passes count of successfully moved valid datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountAll: Passes the count of all files found in the datasheet file folder
' back to the calling routine by reference for status displays, etc.
' Also used, on first call, to pass the initial count from the calling
' routine (see entry in "Inputs", above).
'-------------------------------------------------------------------------------------------------------------
'
'Define the local variables.
Dim strFileName As String
Dim strFullFileName As String
Dim strDirSpec As String
On Error GoTo ErrorHandler
'Initialize.
lCountInvalidTotal = 0
lCountRenameTotal = 0
lCountInvalidGood = 0
lCountRenameGood = 0
lCountValidTotal = 0
lCountValidGood = 0
lCountAll = 0
'Set Dir$ function specification (directory path and search criteria).
'NOTE: Search criteria is "all files", rather than just "text files"
' since text files are validated later as part of the specific
' datasheet file validation process.
If Right$(strDSfolderName, 1) <> "\" Then
strDirSpec = strDSfolderName & "\*.*" 'Add trailing backslash (if needed) and search for any file.
Else
strDirSpec = strDSfolderName & "*.*" 'Add search for any text file.
End If
'strFileName = Dir$(strDirSpec, vbNormal)
'Loop through each file in the folder
'Do While (strFileName <> "")
Do
'Loop through all matching files in directory.
'strFileName = Dir$
strFileName = Dir$(strDirSpec, vbNormal)
If (strFileName <> "") Then
Call subProcessDSfile(strOperation, strFileName, strDSfolderName, strDSbadLocation, strWebLoc, _
strDSlogNameLoc, iLogFileHandle, lCountInvalidTotal, lCountRenameTotal, lCountInvalidGood, lCountRenameGood, _
lCountValidTotal, lCountValidGood)
lCountAll = lCountAll + 1 'Increment total count.
frmSplash.lblFileCount.Caption = lCountAll
frmSplash.lblCurrentFile.Caption = strFileName
frmSplash.lblFileCount.Refresh
frmSplash.lblCurrentFile.Refresh
Else
Exit Do
End If
Loop
Exit Sub 'Exit before error handler.
ErrorHandler:
MsgBox ("Error in ""subProcessDSfolder"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Sub
Private Sub subProcessDSfile(ByVal strOperation As String, ByVal strDSFileName As String, ByVal strDSfolderName As String, _
ByVal strDSbadLocation As String, ByVal strDSwebFolderName As String, ByVal strDSlogNameLoc As String, _
ByVal iLogFileHandle As Integer, ByRef lCountInvalidTotal As Long, ByRef lCountRenameTotal As Long, _
ByRef lCountInvalidGood As Long, ByRef lCountRenameGood As Long, _
ByRef lCountValidTotal As Long, ByRef lCountValidGood As Long)
'-------------------------------------------------------------------------------------------------------------
'Subroutine to process the passed file name. If it is determined to be an invalid name for the Dataforth
'website, the file is moved to the passed directory location and this action is recorded in a log file
'whose name and location is also passed as a parameter. If the file name matches the format of "encoded"
'datasheet file names from the DOS test programs, the file is renamed to the appropriate "unencoded"
'datasheet file name and this action is also recorded to the specified log file. The subroutine posts
'error messages for problems that may be encountered during file processing, and passes file counts
'(total files found to be renamed or moved, files successfully rename or moved) to the calling routine.
'
' Inputs:
' strOperation: Datasheet file operation ("list", "count", "in place", "web move", etc.).
' strDSfileName: Datasheet file name.
' strDSbadLocation: In certain operations, this is the directory location where invalid ("bad")
' files are moved. Invalid files include non-text files and files with names
' that do not match the format for the Dataforth website.
' strDSwebFolderName: In certain operations, this is the directory location where valid or renamed
' files are moved.
' strDSlogNameLoc: Directory location and file name of log file to record datasheet file moves and
' renames.
' iLogFileHandle: File "handle" (file number) for log file.
' lCountInvalidTotal: Passes initial count of invalid ("bad") datasheet files to the
' subroutine. Also used to pass total count back to the calling
' routine for status displays (see entry in "Outputs", below).
' lCountRenameTotal: Passes initial count of renamed datasheet files to the subroutine.
' Also used to pass total count back to the calling routine for status
' displays or log file footer (see entry in "Outputs", below).
' lCountInvalidGood: Passes initial count of invalid ("bad") datasheet files to the
' subroutine. Also used to pass total count back to the calling
' routine for status displays (see entry in "Outputs", below).
' lCountRenameGood: Passes initial count of renamed datasheet files to the subroutine.
' Also used to pass total count back to the calling routine for status
' displays or log file footer (see entry in "Outputs", below).
' lCountValidTotal: Passes initial count of valid datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidGood: Passes initial count of successfully moved valid datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' Outputs:
' Error messages, log file entries.
' lCountInvalidTotal: Passes count of invalid datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountRenameTotal: Passes count of DOS-encoded datasheet files found back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountInvalidGood: Passes count of successfully moved invalid datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountRenameGood: Passes count of successfully renamed DOS-encoded datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidTotal: Passes count of valid datasheet files found back to the calling
' routine by reference for status displays, log file footer, etc.
' Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
' lCountValidGood: Passes count of successfully moved valid datasheet files back to
' the calling routine by reference for status displays, log file footer,
' etc. Also used, on first call, to pass the initial count from the
' calling routine (see entry in "Inputs", above).
'-------------------------------------------------------------------------------------------------------------
'
'Define the local variables.
Dim strWorkOrderNum As String 'Work order number.
Dim strFullFileName As String 'Full file name (including extension).
Dim strFileNameOnly As String 'File name (only).
Dim iDashLoc As Integer 'Dash location in file name (only) string.
Dim iFNOlength As Integer 'Length of file name (only) string.
Dim strWOdecoded As String 'Work order number.
On Error GoTo ErrorHandler
'Get uppercase-only version of the full file name.
'This is necessary for later processing of the
'datasheet files (including determining whether
'they are validly-named datasheet files).
strFullFileName = UCase$(strDSFileName)
'Get the file name (only). This should be the (encoded
'or unencoded) module serial number. Note that the
'function requires a full file name already in
'all-UPPERCASE.
strFileNameOnly = funcGetFileNameOnly(strFullFileName)
'Check for text file.
If (strFileNameOnly = "") Then
'Not a text file (null return from funcGetFileNameOnly).
'Move file to the specified "bad" file location and log action to specified log file.
lCountInvalidTotal = lCountInvalidTotal + 1 'Increment "bad" file count.
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSbadLocation, strDSlogNameLoc, iLogFileHandle) Then
lCountInvalidGood = lCountInvalidGood + 1 'Increment "bad" file processed correctly ("good") count.
End If
Exit Sub 'Exit early for non-text file.
End If
'Check for valid dash location (and/or existence) and a valid dash number.
iDashLoc = funcGetDashLoc(strFileNameOnly) 'Get dash location.
'Check for valid location.
If Not (funcGetDashLoc(strFileNameOnly) > 0) Then
'Dash (or dash number) is not valid.
'Move file to the specified "bad" file location and log action to specified log file.
lCountInvalidTotal = lCountInvalidTotal + 1 'Increment "bad" file count.
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSbadLocation, strDSlogNameLoc, iLogFileHandle) Then
lCountInvalidGood = lCountInvalidGood + 1 'Increment "bad" file processed correctly ("good") count.
End If
Exit Sub 'Exit early for non-datasheet file (no or invalid dash or invalid dash number).
End If
'Parse work order# (characters to the left of
'the dash) from the serial number string.
strWorkOrderNum = Left$(strFileNameOnly, iDashLoc - 1)
If (funcIsAllNumbers(strWorkOrderNum) = True) Then
'Work order number string is all numbers,
'check for leading "0".
If (Left$(strWorkOrderNum, 1) = "0") Then
'Leading "0" in all-numeric work order number. Work order number is not valid.
'Move file to the specified "bad" file location and log action to specified log file.
lCountInvalidTotal = lCountInvalidTotal + 1 'Increment "bad" file count.
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSbadLocation, strDSlogNameLoc, iLogFileHandle) Then
lCountInvalidGood = lCountInvalidGood + 1 'Increment "bad" file processed correctly ("good") count.
End If
Exit Sub 'Exit early for non-datasheet file (no or invalid dash or invalid dash number).
Else
'Valid work order number. Move file to "web folder".
lCountValidTotal = lCountValidTotal + 1 'Increment already-valid file count.
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSwebFolderName, strDSlogNameLoc, iLogFileHandle) Then
lCountValidGood = lCountValidGood + 1 'Increment already-valid files moved successfully count.
End If
End If
Else
'Work order string is not all numbers. Check if
'it is matches the format of a DOS-encoded work
'order number.
If (funcISrenameWO(strWorkOrderNum) = True) Then
'DOS-encoded work order number. Rename file
'to unencoded datasheet file name.
lCountRenameTotal = lCountRenameTotal + 1 'Increment "renamed" file count.
If funcDSmoveRename(RENAME_FILE, strFullFileName, strDSfolderName, "", strDSlogNameLoc, iLogFileHandle) Then
'File successfully renamed in place. Move to "web folder".
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSwebFolderName, strDSlogNameLoc, iLogFileHandle) Then
lCountRenameGood = lCountRenameGood + 1 'Increment "renamed" file processed correctly ("good") count.
End If
End If
Else
'Not a DOS-encoded work order number. Work order number is not valid.
'Move file to the specified "bad" file location and log action to specified log file.
lCountInvalidTotal = lCountInvalidTotal + 1 'Increment "bad" file count.
If funcDSmoveRename(MOVE_FILE, strFullFileName, strDSfolderName, strDSbadLocation, strDSlogNameLoc, iLogFileHandle) Then
lCountInvalidGood = lCountInvalidGood + 1 'Increment "bad" file processed correctly ("good") count.
End If
Exit Sub 'Exit early for non-datasheet file (no or invalid dash or invalid dash number).
End If
End If
Exit Sub 'Exit before error handler.
ErrorHandler:
MsgBox ("Error in ""subProcessDSfiles"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Sub
Private Function funcGetFileNameOnly(ByVal strFullFileName As String) As String
'----------------------------------------------------------------------------------------------------
'This function returns the file name (only) portion of the full file name (file name plus extension).
'The file name, in the case of datasheet files, is the module serial number. This is returned
'if the proper file extension is found (".TXT"). If the proper extension is not found,
'or there is some other problem (such as a blank file name passed to the function), a null string
'is returned.
'
'NOTE: The passed full file name must be in all-UPPERCASE for the ".TXT" check to work.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim strSerial As String 'Serial number portion of the complete file name (file name, without the extension).
Dim iSTRlength As Integer 'Length of serial number or complete file name string.
On Error GoTo ErrorHandler
If (strFullFileName <> "") Then
'Get serial number (file name) from complete file name.
If (Right$(strFullFileName, 4) = ".TXT") Then
'Strip off last four characters (.TXT file extension) from full file name
'to create the file name only (serial number) string.
iSTRlength = Len(strFullFileName) 'Get length of the full file name.
strSerial = Left$(strFullFileName, iSTRlength - 4) 'Strip off last four characters (".txt").
funcGetFileNameOnly = strSerial
Else
funcGetFileNameOnly = "" 'Error value.
End If
Else
'Invalid (null) file name.
funcGetFileNameOnly = "" 'Error value.
End If
Exit Function ' Exit before error handler.
ErrorHandler:
funcGetFileNameOnly = "" 'Error value.
MsgBox ("Error in ""funcGetFileNameOnly"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Function funcIsAllNumbers(ByVal strTestString As String) As Boolean
'----------------------------------------------------------------------------------------------------
'Function that checks whether the passed string consists of only numerical characters. The function
'returns "True" if each character in the string is a number, and "False" if any character is not
'a number or if there is some other problem in the function.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim strChar As String
Dim iDx As Integer
On Error GoTo ErrorHandler
'Initialize to "all numbers" value.
funcIsAllNumbers = True
If (strTestString = "") Then
'Invalid Work Order number string (null string).
funcIsAllNumbers = False 'Set "not all numbers" value.
Else
For iDx = 1 To Len(strTestString) 'Loop from 1st character to last character of string.
'See if the next character is a non-number.
strChar = Mid$(strTestString, iDx, 1) 'Get next character.
If ((strChar < "0") Or (strChar > "9")) Then 'Character is not "0" through "9".
funcIsAllNumbers = False 'Set "not all numbers" value.
Exit For 'Exit the loop (no need to continue after first non-number).
End If
Next iDx
End If
Exit Function ' Exit before error handler.
ErrorHandler:
funcIsAllNumbers = False 'Error ("not all numbers") value.
MsgBox ("Error in ""funcIsAllNumbers"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcGetDashLoc(ByVal strFileNameOnly As String) As Integer
'----------------------------------------------------------------------------------------------------
'This function returns the dash ("-") location in the passed file name (only) string. It returns
'an error value of "0" if no dash is found, or more than one dash is found, if there are more
'than one characters after the dash, and if any of the characters after the dash are not a
'number, or if there are any other problems in the function.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim iSTRlength As Integer 'Length of serial number string.
Dim iDashLocL As Integer 'Location of dash, when searched for from the left.
Dim iDashLocR As Integer 'Location of dash, when searched for from the right.
Dim strDashNum As String 'Dash number string.
On Error GoTo ErrorHandler
iSTRlength = Len(strFileNameOnly) 'Length of file name (only) string.
'Location of dash (characters from start (left) of string) when searched from the left.
iDashLocL = InStr(strFileNameOnly, "-")
'Location of dash (characters from start (left) of string) when searched from the right.
iDashLocR = InStrRev(strFileNameOnly, "-")
If (iDashLocL = iDashLocR) Then
'Dash in same location = only one dash in the string.
'
'Start dash location validation.
If (((iSTRlength - iDashLocL) > 2) Or ((iSTRlength - iDashLocL) = 0)) Then
'Too many characters after the dash, or dash at end (dash number
'more than two characters, or less than one).
funcGetDashLoc = 0 'Error value (invalid dash).
Else
'Dash number is one or two characters. Get for an all-number dash number.
strDashNum = Mid$(strFileNameOnly, iDashLocL + 1, iSTRlength - iDashLocL)
If (funcIsAllNumbers(strDashNum) = True) Then
'Dash number is all numbers.
funcGetDashLoc = iDashLocL 'Good value (valid dash).
Else
'Dash number is not valid (not all numbers).
funcGetDashLoc = 0 'Error value (invalid dash).
End If
End If
Else
'More than one dash in the serial string.
funcGetDashLoc = 0 'Error value (invalid dash).
End If
Exit Function 'Exit before error handler.
ErrorHandler:
funcGetDashLoc = 0 'Error (not valid) value.
MsgBox ("Error in ""funcIsValidDash"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcDecodeWOchar(ByVal strWOnum As String) As String
'----------------------------------------------------------------------------------------------------
'This function returns a two-character string decoded from the first character of the
'passed work order number string. If the first character is "A" through "J", the
'function returns "10" through "19", respectively, which represents the values that
'are encoded in valid DOS-encoded datasheet file names. If the first character is
'not "A" or "J" or a letter in between, or if there is some problem in the function,
'the function returns a null string.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim strFirstChar As String 'First character in passed work order number string.
On Error GoTo ErrorHandler
If (strWOnum = "") Then
'Null string, return error value (null string).
funcDecodeWOchar = "" 'Error value.
Else
'String has at least one character, check for "A" through "J".
strFirstChar = Left$(strWOnum, 1) 'Get first character of passed work order number.
If (strFirstChar = "A") Then
funcDecodeWOchar = "10" 'Decode of first character.
ElseIf (strFirstChar = "B") Then
funcDecodeWOchar = "11" 'Decode of first character.
ElseIf (strFirstChar = "C") Then
funcDecodeWOchar = "12" 'Decode of first character.
ElseIf (strFirstChar = "D") Then
funcDecodeWOchar = "13" 'Decode of first character.
ElseIf (strFirstChar = "E") Then
funcDecodeWOchar = "14" 'Decode of first character.
ElseIf (strFirstChar = "F") Then
funcDecodeWOchar = "15" 'Decode of first character.
ElseIf (strFirstChar = "G") Then
funcDecodeWOchar = "16" 'Decode of first character.
ElseIf (strFirstChar = "H") Then
funcDecodeWOchar = "17" 'Decode of first character.
ElseIf (strFirstChar = "I") Then
funcDecodeWOchar = "18" 'Decode of first character.
ElseIf (strFirstChar = "J") Then
funcDecodeWOchar = "19" 'Decode of first character.
Else
'Not "A" through "J"
funcDecodeWOchar = "" 'Error value.
End If
End If
Exit Function ' Exit before error handler.
ErrorHandler:
funcDecodeWOchar = "" 'Error value.
MsgBox ("Error in ""funcDecodeWOchar"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcISrenameWO(ByVal strWOnumber As String) As Boolean
'----------------------------------------------------------------------------------------------------
'This function returns "True" if the passed work order number matches the format of a DOS-encoded
'work order number (for work orders above the value of "99,999"). A DOS-encoded work order number
'will be five characters long, start with "A" through "J", and have all numbers for the remaining
'characters. The function will return "False" if any of these conditions are not true, or there is
'any other problem in the function.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim strLastFour As String
Dim strFirstOne As String
On Error GoTo ErrorHandler
If (Len(strWOnumber) <> 5) Then
'Not five characters long.
funcISrenameWO = False 'Set "not a valid rename string" value.
Else
strFirstOne = UCase$(Left$(strWOnumber, 1))
If ((strFirstOne < "A") Or (strFirstOne > "J")) Then
'First character not "A" through "J".
funcISrenameWO = False 'Set "not a valid rename string" value.
Else
strLastFour = Right$(strWOnumber, 4)
If (funcIsAllNumbers(strLastFour) = True) Then
funcISrenameWO = True 'Set "valid rename string" value.
Else
'Last four characters not all numberss.
funcISrenameWO = False 'Set "not a valid rename string" value.
End If
End If
End If
Exit Function ' Exit before error handler.
ErrorHandler:
funcISrenameWO = False 'Error value (not valid "rename" string).
MsgBox ("Error in ""funcISrenameWO"" = " & Err.Description & vbCrLf & vbCrLf & _
"Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcDSmoveRename(ByVal bMoveFile As Boolean, ByRef strDSFileName As String, ByVal strDSfolderName As String, _
ByVal strDSmoveLocation As String, ByVal strDSlogNameLoc As String, ByVal iLogFileHandle As Integer) As Boolean
'-------------------------------------------------------------------------------------------------------------
'Function that moves or renames the file specified by the passed file name and datasheet file folder. If the
'move/rename parameter ("bMoveFile") is "True", the file is moved to the directory specified by the
'passed "move location" folder name. If the parameter is "False", the file is renamed from the DOS-encoded
'name to the unencoded datasheet file name. In both cases, the "move" or "rename" is accomplished by copying the
'file to the new name or location, and then deleting the old file if nothing has gone wrong. All actions,
'including successful moves or renames, unsuccessful file copies, or unsuccessful file deletions, are
'recorded in a log file whose name and location, as well as its file number (file "handle"), are passed
'as parameters. The function returns "True" if there are no problems, and "False" if there are any problems.
'The function also returns (by reference) the new datasheet file name of renamed files.
'
'NOTE: Since the existence of all of the relevant directories is verified by one of the calling routines
' directory checking is not repeated here to save program time (since this function is called for
' every relevant file).
'
' Inputs:
' bMoveFile: This parameter is "True" to move the specified file to the "move"
' folder or "False" to rename the specified file from the
' DOS-encoded work order number (for values above "99,999") to the
' unencoded work order number (file name matching the module serial
' number contained within the datasheet file).
' strDSFileName: Full file name of the file to be moved (includes file extension
' but not folder location).
' strDSfolderName: Datasheet folder location.
' strDSmoveLocation: Directory location where the file is to be moved.
' strDSlogNameLoc: Directory location and file name of log file to record the file move.
' iLogFileHandle: File "handle" (file number) for log file.
' Outputs:
' Error messages, log file entries.
' strDSFileName: Full file name of the renamed datasheet file (includes file extension
' but not folder location).
'-------------------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim strLogFileLine As String 'String for a line of information for the log file.
Dim strRenameFileName As String 'Full file name (name and extension) for the renamed (unencoded) datasheet file name.
Dim strDSFileNameLoc As String 'Full file name (name and extension) and folder of the file in the datasheet folder.
Dim strRenameFileNameLoc As String 'Full file name (name and extension) and folder for the renamed (unencoded) datasheet file name.
Dim strRenameFirstChars As String 'First character of file to be renamed, or (decoded) first two characters of renamed file.
Dim iLenFullFileName As Integer 'Length of the full file name of the file to be renamed.
Dim objFSO As FileSystemObject 'File system object for log file.
On Error GoTo ErrorHandler
'Initialize function return.
funcDSmoveRename = False 'Initialize to bad return (set to good at end if there are no problems).
'Initialize strings to null.
strLogFileLine = ""
strRenameFileName = ""
strDSFileNameLoc = ""
strRenameFileNameLoc = ""
strRenameFirstChars = ""
'Create an instance of the FileSystemObject (project must reference the
'Windows Scripting Library: Scrrun.dll).
Set objFSO = CreateObject("Scripting.FileSystemObject")
'Create the full file name and location from the full file
'name and the folder location. First, add a trailing
'backslash, if needed, to the folder location.
If Right$(strDSfolderName, 1) <> "\" Then strDSfolderName = strDSfolderName & "\"
strDSFileNameLoc = strDSfolderName & strDSFileName
'If the file needs to be renamed, create the full "rename" file name
'(file name and extension) from the original DOS-encoded name, then
'create the full name/location (file name and folder location).
If Not (bMoveFile) Then
'File to be renamed. Decode first character of full file name.
strRenameFirstChars = Left$(strDSFileName, 1) 'Get first character of file to be renamed.
iLenFullFileName = Len(strDSFileName) 'Get the length of the full file name of the file to be renamed.
'Use the "decode work order character" function to decode the first character of the full
'file name of the file to be renamed (note, the function name implies the passed string
'is the work order number only, but since the function only uses the first character of
'the string, it also works for the full file name).
strRenameFirstChars = funcDecodeWOchar(strDSFileName) 'Get decoded first two characters of full file name.
'Create the renamed file name, by combining the new decoded characters with the characters of the full
'datasheet file name to be renamed, but skipping the first character.
strRenameFileName = Right$(strDSFileName, iLenFullFileName - 1) 'Get full file name minus the first character.
strRenameFileName = strRenameFirstChars & strRenameFileName 'Create full rename file name by adding decoded characters.
strRenameFileNameLoc = strDSfolderName & strRenameFileName 'Create full rename file name/location by adding folder.
'NOTE: This is the same folder as the original
' datasheet file.
strDSFileName = strRenameFileName 'Return renamed datasheet file name.
End If
'Create "could not copy" message for log file.
'NOTE: This is done BEFORE the copy is attempted, because the CopyFile method
' throws an error if it fails, which is the only way an unsuccesful
' operation can be detected. This message is then printed to the log
' file in the error handler. Any "copy good" message will have to wait
' until after all operations, just before the error handler, to be
' run only if there are no errors.
If (bMoveFile) Then
'Invalid file "could not copy" message.
strLogFileLine = "Could not copy file: " & strDSFileNameLoc & " to: " & strDSmoveLocation
Else
'Rename file "could not delete" message.
strLogFileLine = "Could not copy file: " & strDSFileNameLoc & " to: " & strRenameFileName
End If
'Copy the file in the datasheet folder. For moves, copy to the "move" directory.
'For rename, copy to a new name in the same folder. File copy parameters:
'source (full file name/loc), destination (folder
'only or full (rename) file name/loc), "True" for
'overwrite if a file of same name already exists
'in the destination.
If (bMoveFile) Then
'Move invalid file. Start by copying to new folder location.
Call objFSO.CopyFile(strDSFileNameLoc, strDSmoveLocation, True)
Else
'Rename DOS-encoded datasheet file. Start by copying to name in same folder.
Call objFSO.CopyFile(strDSFileNameLoc, strRenameFileNameLoc, True)
End If
'Create "could not delete" message for log file.
'NOTE: This is done BEFORE the copy is attempted, because the DeleteFile method
' throws an error if it fails, which is the only way an unsuccesful
' operation can be detected. This message is then printed to the log
' file in the error handler. Any "delete good" message will have to wait
' until after all operations, just before the error handler, to be
' run only if there are no errors.
If (bMoveFile) Then
'Invalid file "could not delete" message.
strLogFileLine = "Could not delete file: " & strDSFileNameLoc & " after copy to: " & strDSmoveLocation
Else
'Rename file "could not delete" message.
strLogFileLine = "Could not delete file: " & strDSFileNameLoc & " after copy to: " & strRenameFileName
End If
'Delete the invalid file in the datasheet folder.
'File delete parameters: full file/loc, "True"
'for "force" (ignore read-only).
Call objFSO.DeleteFile(strDSFileNameLoc, True)
'Since there were no problems to this point (no jump to the error handler),
'create "successfully moved" or "successfully renamed" message and write
'the message to the log file.
If (bMoveFile) Then
strLogFileLine = "Moved file: " & strDSFileNameLoc & " to: " & strDSmoveLocation
Else
strLogFileLine = "Renamed file: " & strDSFileNameLoc & " to: " & strRenameFileName
End If
Print #iLogFileHandle, strLogFileLine 'Write line to log file.
funcDSmoveRename = True 'Set Good function return.
Set objFSO = Nothing 'Destroy file system object.
Exit Function ' Exit before error handler.
ErrorHandler:
Print #iLogFileHandle, strLogFileLine 'Write previously-generated error message to log file.
Set objFSO = Nothing 'Destroy file system object.
'NOTE: Since this function processes many files, errors should be posted (only) to the log
' file, NOT to the screen. Therefore, the following two lines (single line of code)
' are (is) commented out.
'MsgBox ("Error in ""funcDSmoveRename"" = " & Err.Description & vbCrLf & vbCrLf & _
' "Contact engineering before proceeding!"), vbCritical
End Function
Private Function funcGetOPnumber(ByVal strOPname As String) As Integer
'----------------------------------------------------------------------------------------------------
'This function returns the appropriate enumerated operation number from the passed
'operation string.
'----------------------------------------------------------------------------------------------------
'
'Define the variables.
Dim iReturn As Integer
On Error GoTo ErrorHandler
If (strOPname = "COUNT") Then
iReturn = 1
ElseIf (strOPname = "LISTALL") Then
iReturn = 2
ElseIf (strOPname = "LISTBAD") Then
iReturn = 3
ElseIf (strOPname = "LISTRENAME") Then
iReturn = 4
ElseIf (strOPname = "INPLACE") Then
iReturn = 5
ElseIf (strOPname = "WEBMOVE") Then
iReturn = 6
Else
iReturn = 0 'Error value.
MsgBox ("Error in ""funcGetOPnumber"" = " & vbCrLf & _
"Invalid operation = " & strOPname & vbCrLf & _
"Function return = " & iReturn & vbCrLf), vbCritical
End If
funcGetOPnumber = iReturn 'Set function return.
Exit Function ' Exit before error handler.
ErrorHandler:
iReturn = 0 'Error value.
funcGetOPnumber = iReturn 'Set function return.
MsgBox ("Error in ""funcGetOPnumber"" = " & Err.Description & vbCrLf & _
"Function return = " & iReturn & vbCrLf), vbCritical
End Function
Reference in New Issue View Git Blame Copy Permalink