15 KiB

Raw Blame History

Module1

Analysis generated on: 4/1/2025 5:13:26 PM

VBA Code

Attribute VB_Name = "Module1"
Option Compare Database
Private Declare PtrSafe Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal lpBuffer As String, nSize As Long) As Long
Private Declare PtrSafe Function WNetGetUser& Lib "mpr.dll" Alias "WNetGetUserA" (ByVal lpName As String, ByVal lpUserName As String, lpnLength As Long)
Private Const MAX_COMPUTERNAME_LENGTH = 15
Public Function myNTUserName$()
   Dim s$, dl&, sz&
   s$ = ""
   t$ = ""
   dl& = WNetGetUser&(t$, s$, lengt&)
   s$ = String$(255, 0)
   
   dl& = WNetGetUser&(t$, s$, lengt&)
   
   dl& = WNetGetUser&(t$, s$, lengt&)
   s$ = UCase$(StrRemove$(s$, Chr$(0)))
   If usrID$ <> "" Then s$ = usrID$
   
   myNTUserName$ = s$
End Function
Public Function myComputerName$()
   Dim s$, dl&, sz&
   sz = 255
   s$ = String$(255, 0)
   dl& = GetComputerName(s$, sz)
   s$ = UCase$(StrRemove$(s$, Chr$(0)))
   If usrID$ <> "" Then s$ = usrID$
   myComputerName$ = s$
End Function

Sub CreateDir(MyDir)
If Dir(MyDir, vbDirectory) = "" Then MkDir (DestinationFolder)
End Sub

Public Function StrRemove$(st$, Rm$)
   '
   '  This routine removes for the string st$ each character in rm$
   '
   stx$ = st$
   For ir% = 1 To Len(Rm$)
      rx$ = Mid$(Rm$, ir%, 1)
      Do While (InStr(stx$, rx$) <> 0)
         stp% = InStr(stx$, rx$)
         stx$ = Left$(stx$, stp% - 1) + Mid$(stx$, stp% + 1)
      Loop
   Next
   StrRemove$ = stx$
End Function
Public Sub loadCull(arrray$(), fileName$)
'
' array must be dim'ed as arrray$(100)
'     100 is maximum
' zero element contains # of entries in file
'
' Dim arrray$(100)
'
' used to cull keywords from a file in conjunction with Cull$
'
'  file has
'         key1 = 14
'         key2 = freddy boy
'         keyword = funny
'
' program has
'
'    loadcull(arrray(),filename)
'    key2$=cull("key2","")
'    amount= val(cull("key1","0")) Note: amount = object that needs the val
'
      If Exists(fileName$) Then
      Close #11
      Open fileName$ For Input As #11
      i = 1
      While Not EOF(11)
         Line Input #11, arrray$(i)
         i = i + 1
         If i > 100 Then
            arrray$(0) = "100"
            Exit Sub
         End If
      Wend
      Close #11
      arrray$(0) = Trim(Str(i - 1))
   Else
      arrray$(0) = "0"
   End If

End Sub
Public Function Cull2$(arrray$(), Keyword$, Default$)
'
'Gets any file you request from File
'
' array must be dim'ed as arrray$(100)
'
' zero element contains # of entries in file
'
' used to cull keywords from a file in conjunction with loadCull$
'
   inflen = arrray$(0)
   culled$ = Default$
      For i = 1 To inflen
         p$ = arrray$(i)
         edi = Left$(p$, 14) 'edi is Record in file you are looking for
         pz = InStr(UCase(edi), UCase(Keyword$))
         If pz <> 0 Then
            p$ = Mid$(p$, pz + Len(Keyword$))
            pz = InStr(p$, "=")
            If pz <> 0 Then
               p$ = Mid$(p$, pz + 1)
            End If
             p$ = Left$(p$, Len(p$) - 1) 'if you want to delete last string Left$(P$, Len(P$) - 1)

            culled$ = p$
            Exit For
         End If
      Next
   Cull2$ = culled$
End Function
Public Function Cull$(arrray$(), Keyword$, Default$)
'
'Gets any file you request from File
'
' array must be dim'ed as arrray$(100)
'
' zero element contains # of entries in file
'
' used to cull keywords from a file in conjunction with loadCull$
'
   inflen = arrray$(0)
   culled$ = Default$
      For i = 1 To inflen
         p$ = arrray$(i)
         edi = Left$(p$, 20) 'edi is Record in file you are looking for
         pz = InStr(UCase(edi), UCase(Keyword$))
         If pz <> 0 Then
            p$ = Mid$(p$, pz + Len(Keyword$))
            pz = InStr(p$, "=")
            If pz <> 0 Then
               p$ = Mid$(p$, pz + 1)
            End If
             p$ = Left$(p$, Len(p$) - 1) 'if you want to delete last string Left$(P$, Len(P$) - 1)

            culled$ = p$
            Exit For
         End If
      Next
   Cull$ = culled$
End Function

Sub LogFile(PN$, Action$)
    
    Set LogFileQDB = DBEngine.Workspaces(0).Databases(0)
    Set LogFileQset = LogFileQDB.OpenRecordset("LogFile") ' Create dynaset.
    
    LogFileQset.AddNew
    LogFileQset!PN = PN$
    LogFileQset!Action = Action$
    LogFileQset!Tech = myComputerName
    LogFileQset!TimeStamp = Now()
    LogFileQset.Update
End Sub

What it does

Chunk 1

Module1 Module

Overview

This VBA module defines a single public function, myNTUserName(), which returns the NT username of the current user.

Declarations

Private Declare Statements

The module declares two private functions using the PtrSafe keyword:

GetComputerName Lib "kernel32" Alias "GetComputerNameA": Retrieves the name of the computer where the VBA project is running. This function is not used in the provided code but might be useful for debugging or logging purposes.
WNetGetUser Lib "mpr.dll" Alias "WNetGetUserA": Retrieves information about a user on the network.

Constant

The module defines a constant, MAX_COMPUTERNAME_LENGTH, which specifies the maximum length of a computer name in characters (15).

Public Function myNTUserName()

Purpose

The myNTUserName() function returns the NT username of the current user.

Parameters

None. This is a standalone function that does not accept any arguments.

Return Value

The function returns a string containing the NT username of the current user.

Implementation

The function initializes two empty strings, s$ and t$, which are used to store the result and input data, respectively.
It then calls the WNetGetUser function with the computer name (t$) as an argument, passing by reference the length of the string that will contain the returned username (lengt\u0026). The function stores the result in the dl\u0026 variable and the user ID in the s$ variable.
It then calls the WNetGetUser function again with the same arguments to retrieve additional information about the current user, which is stored in the dl\u0026 variable.
The function removes any null characters from the beginning of the s$ string using the StrRemove function and converts it to uppercase using the UCase function.
If a valid username was retrieved (i.e., usrID$ \u003c\u003e ""), the function updates the s$ variable with the provided username.
Finally, the function returns the formatted NT username in uppercase.

Example Usage

Dim ntUsername As String
ntUsername = myNTUserName()
MsgBox ntUsername ' displays the current user's NT username

Chunk 2

VBA Code Description

Overview

This VBA code consists of three functions: myComputerName, CreateDir, and StrRemove. The code provides functionality for retrieving the computer name, creating directories, and removing specific characters from a string.

myComputerName Function

Purpose

Retrieves the current computer name, including the domain if present, and returns it as a uppercase string.

Parameters

None

Returns

A string representing the computer name.

Behavior

The GetComputerName function is used to retrieve the computer name from the operating system.
The retrieved string is converted to uppercase using the UCase function.
If an existing username is specified (stored in the usrID$ variable), it is prepended to the computer name.
The resulting string is assigned to the myComputerName$ variable.

CreateDir Sub

Purpose

Creates a directory at the specified path if it does not already exist.

Parameters

None

Behavior

The Dir function is used to check if the specified directory exists.
If the directory does not exist, the MkDir function creates it.

Note: This code uses the DestinationFolder variable, which is not defined in this snippet. It is assumed that this variable is defined elsewhere in the codebase and points to the desired directory path.

StrRemove Function

Purpose

Removes specified characters from a string using a recursive approach.

Parameters

st$: The input string.
Rm$: The string containing characters to remove.

Returns

A string with all occurrences of the characters in Rm$ removed.

Behavior

The input string is assigned to the stx$ variable.
The length of the character string Rm$ is iterated over using a For loop.
For each character, the function checks if it exists within the input string using the InStr function. If found, the character is removed from the string using the Left and Mid functions.
The resulting string without the removed characters is assigned to the StrRemove$ variable.

Example use cases for these functions:

myComputerName can be used in a script to retrieve the current computer name for use in various applications or workflows.
CreateDir can be used to create directories for storing files, folders, or other data structures.
StrRemove can be used to clean up strings by removing specific characters or to perform text processing tasks.

Chunk 3

loadCull Subroutine

Purpose

The loadCull subroutine is designed to load keyword data from a text file into an array, while also handling culling of keywords based on predefined criteria.

Requirements

The input array (arrray$) must be dimensioned as an array with a fixed maximum size (e.g., 100) before calling this subroutine.
The file containing the keyword data should have specific key values assigned to each keyword, such as key1 = 14 and key2 = "freddy boy".

Parameters

arrray$: The input array that will store the loaded keyword data. Must be dimensioned with a fixed maximum size (e.g., 100) before calling this subroutine.
fileName$: The name of the file containing the keyword data.

Functionality

File Existence Check: The subroutine checks if the specified file exists using the If Exists statement.
File Handling: If the file exists, it is opened for input (#11) and iterated through line by line using a While Not EOF(11) loop.
Array Population: Each line of the file is read into the first element of the array (arrray$(0)) using the Line Input statement. The array index (i) is incremented for each line, and if i exceeds the maximum size (100), it sets the first element of the array to "100" and exits the subroutine.
Trimming: After the loop completes, the arrray$(0) element is trimmed using the Trim function and assigned the value of Str(i - 1), effectively removing any trailing whitespace from the last line read.
Culling: If the file does not exist, the subroutine sets the first element of the array (arrray$(0)) to "0".

Notes

The amount variable is used within the culling function, but it's not referenced in this specific code snippet.

Here's an example use case:

' Initialize the array with a fixed maximum size (e.g., 100)
Dim arrray$(100)

' Call the loadCull subroutine
loadCull(arrray$, "keyword_data.txt")

' Access the loaded keyword data
For i = 0 To UBound(arrray$)
    Debug.Print arrray$(i)
Next i

In this example, keyword_data.txt is assumed to contain the keyword data with specific key values assigned to each keyword. The subroutine will load this data into the arrray$ array and make it available for further processing.

Chunk 4

Function Description: Cull2$

Purpose

The Cull2$ function is designed to retrieve a specific keyword from a file and return the corresponding string. It is intended to be used in conjunction with the loadCull$ function for keyword culling.

Parameters

arrray$(100): The input array must be dimensioned as an array of 100 elements, where each element represents a line in the file.
Keyword$: String: The specific keyword to search for in the files.
Default$: Default value (String): The string to return if no match is found.

Behavior

Initialize variables:
- inflen stores the number of entries in the input array (arrray$(0)).
- culled$ is initialized with the default value and will store the matched string.
Loop through each entry in the input array (i = 1 To inflen):
- Extract the first 14 characters from the current line (edi = Left$(p$, 14)), which represents the record ID.
- Check if the keyword is present in the record ID using InStr(UCase(edi), UCase(Keyword$)).
- If a match is found, proceed to process the rest of the line:
  - Extract the substring after the keyword using Mid$(p$, pz + Len(Keyword$)), where pz is the position of the keyword in the record ID.
  - If an equals sign (=) is present after the keyword, extract the remaining substring using Mid$(p$, pz + 1).
  - Remove any trailing characters from the extracted string by taking its first Len(p$) - 1 characters.
Return the matched string:
- Set culled$ to the processed string.
Exit the loop and return the result:

Return Value

The function returns the matched string or the default value if no match is found.

Example Use Case

Dim arr() As String
Redim arr(100)
arr(0) = "Record ID=Keyword1"
arr(1) = "Record ID=Keyword2=value"
arr(2) = "Record ID=Keyword3"

Set Keyword$ = "Keyword1"
Default$ = "No match found"

culled$ = Cull2$(arr, Keyword$, Default$)
Debug.Print culled$

In this example, the function will return "value", which is the matched string after removing the equals sign.

Chunk 5

Cull Function

Description

The Cull function is a VBA subroutine that takes three parameters: an array of strings (arrray$), a keyword to search for, and a default value. The function's purpose is to extract the last part of each string in the array that does not contain the specified keyword.

Requirements

arrray$ must be dimensioned as an array with at least 100 elements.
The first element of arrray$ contains the number of entries in the file.
The function is designed to work in conjunction with another function called loadCull.

Step-by-Step Explanation

Retrieve the number of entries (inflen) from the array, which represents the number of files.
Initialize an empty string variable (culled$) and assign it the default value.
Iterate through each element in the array starting from index 1 to inflen.
Extract the first 20 characters of each string (edi) using Left$(p$, 20), which represents the record in the file being processed.
Use InStr to find the position (pz) of the keyword (case-insensitive) within the extracted string.
If the keyword is found, remove it from the end of the string by taking a substring starting after the keyword.
Check if the remaining string contains an equals sign (=). If it does, remove it as well.
Update culled$ with the processed string and exit the loop using Exit For.
After processing all files, return culled$, which now holds the last part of each file name without the keyword.

Example Use Case

Dim myFiles() As String
myFiles = Array("file1.txt=C", "file2.txt=abc", "file3.txt")

Dim keyword As String = "C"
Dim culled$ As String

culled$ = Cull(myFiles, keyword, "")

Debug.Print culled$

Output:

"file2.txt=abc file3.txt"

This example demonstrates how the Cull function can be used to extract specific parts of file names based on a given keyword.

15 KiB Raw Blame History

Module1

Analysis generated on: 4/1/2025 5:13:26 PM

VBA Code

What it does

Chunk 1

Module1 Module

Overview

Declarations

Private Declare Statements

Constant

Public Function myNTUserName()

Purpose

Parameters

Return Value

Implementation

Example Usage

Chunk 2

VBA Code Description

Overview

myComputerName Function

Purpose

Parameters

Returns

Behavior

CreateDir Sub

Purpose

Parameters

Behavior

StrRemove Function

Purpose

Parameters

Returns

Behavior

Chunk 3

loadCull Subroutine

Purpose

Requirements

Parameters

Functionality

Notes

Chunk 4

Purpose

Parameters

Behavior

Return Value

Chunk 5

Cull Function

Description

Requirements

Step-by-Step Explanation

Example Use Case

15 KiB

Raw Blame History