Extracting information from a field using Visual Studio 2005 - visual-studio-2005

I need to extract specific information from a field using Visual Studio 2005. I need only the 'partNumber' and the 'serialNumber' from this field;
BeginGroup:databasecurrentFifos=0maximumFifos=34369maximumSpace=6291456percentUsed=7totalFixedSpace=123156totalIndexSpace=77182totalRowCount=2533totalRowSpace=139024totalTableSpace=339362uncollectedFifos=0usedSpace=478386EndGroup:databaseBeginGroup:networkDNS_ServerIP=NoneDNS_DomainName=NoneFTP_Enabled=falseEndGroup:networkBeginGroup:hardwareBeginGroup:biometricsEndGroup:biometricsBeginGroup:mSystemformat=7101processorType=859chipId=CFEndGroup:mSystemBeginGroup:barcodesBarcode_attached=noSymbologies=code3of9
i2of5
code128Remote_Barcode_attached=noEndGroup:barcodesBeginGroup:boardrevision=REV
Aversion=415partNumber=8602800-503serialNumber=JC117590EndGroup:boardBeginGroup:magneticstrackNum=noEndGroup:magneticsBeginGroup:memorySDRAM=134217728BeginGroup:flashDisksflashDisk0=1018773504flashDisk1=0numOfFlashDisks=1EndGroup:flashDisksEndGroup:memoryBeginGroup:peripheralsmodem=noneWand_attached=noEndGroup:peripheralsBeginGroup:keypadKeypad_Type=NumericEndGroup:keypadBeginGroup:proximityReadersProximityReader_attached=noProxReaderFormat1=Default
26 Bit
FormatProximityReader_NumRecords=2RemoteProx_attached=noRemoteProxFormat1=Default
26 Bit
FormatRemoteProx_NumRecords=2EndGroup:proximityReadersEndGroup:hardwareBeginGroup:softwarerelease=03.00.07.006
HTMLClientVersion=5708model=Kronos-4500OSversion=5708bootVersion=5708appVersion=5708dbSchema=5708Font_Information=Default
Latin fonts. EndGroup:software

This answer assumes VB.NET is used and also assumes that structure of the source string doesn't change.
'Variable to hold source data
Dim sSource As String
'*** perform code here to load source (from DB etc.) ***
'separator array (change this as needed if sructure of the source sting changes)
Dim sSep As String() = {"partNumber=", "serialNumber=", "EndGroup:boardBeginGroup:magnetic"}
'split the source into Array
Dim asSplit As String() = sSource.Split(sSep, StringSplitOptions.None)
'get Part Number
Dim sPartNumber As String = asSplit(1)
'get Serial Number
Dim sSerialNumber As String = asSplit(2)

Related

Excel VBA script not running on Excel 2016 with FileSystemObject

I've never used VB(A) before, so forgive me if this is a trivial question.
I am trying to run the code outlined here on Excel 2016 on a Mac.
Sub simpleXlsMerger()
Dim bookList As Workbook
Dim mergeObj As Object, dirObj As Object, filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set dirObj = mergeObj.Getfolder("/...filepath")
Set filesObj = dirObj.Files
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
Range("A2:IV" & Range("A65536").End(xlUp).Row).Copy
ThisWorkbook.Worksheets(1).Activate
'Do not change the following column. It's not the same column as above
Range("A65536").End(xlUp).Offset(1, 0).PasteSpecial
Application.CutCopyMode = False
bookList.Close
Next
End Sub
However, I get the error, that goes off without specifying a line:
Any thoughts on how I can modify this code for Mac?
Try this, based on the other (unaccepted) answer to similar question.
Is there an alternative to Scripting.FileSystemObject in Excel 2011 VBA for the mac?
The problem is that Scripting.Runtime library is not available on Mac OS, so you can't do CreateObject("Scripting.FileSystemObject"). This uses the VBA Dir function to build a Collection of files.
Also revised for more efficient "copy" that doesn't use the Copy method.
(untested, so bear with me in case of typos/etc.)
Sub simpleXlsMerger()
Dim bookList As Workbook, vals as Variant
Dim filesObj As Object, everyObj As Object
Application.ScreenUpdating = False
Set mergeObj = CreateObject("Scripting.FileSystemObject")
'change folder path of excel files here
Set filesObj = GetFileList("/...filepath")
For Each everyObj In filesObj
Set bookList = Workbooks.Open(everyObj)
'change "A2" with cell reference of start point for every files here
'for example "B3:IV" to merge all files start from columns B and rows 3
'If you're files using more than IV column, change it to the latest column
'Also change "A" column on "A65536" to the same column as start point
vals = Range("A2:IV" & Range("A" & Rows.Count).End(xlUp).Row).Value2
With ThisWorkbook.Worksheets(1)
'Do not change the following column. It's not the same column as above
.Range("A" & .Rows.Count).End(xlUp).Offset(1, 0).Resize(UBound(vals, 1), UBound(vals, 2)).Value = vals
End With
bookList.Close
Next
End Sub
Function GetFileList(folderPath As String) As Collection
'mac vba does not support wildcards in DIR function
Dim file As String
Dim returnCollection As New Collection
If Right$(folderPath, 1) <> "\" Then
folderPath = folderPath & "\"
End If
file = Dir$(folderPath) 'setup initial file
Do While Len(file)
returnCollection.Add folderPath & file
file = Dir$
Loop
Set GetFileList = returnCollection
End Function
In the VBA window, click tools then add reference. Make sure Microsoft Office Object Library (14 or 16) is checked. You will need this for the automation.
An alternative idea would be to create a loop and save each excel file as a csv then run a batch script.
Example:
copy *.csv merged.csv
For the CSV loop use:
Converting XLS/XLSX files in a folder to CSV

Vb6 .text property for textbox required

I am trying to convert letters to numbers.
I have a sub which ensures only numbers are put into the textbox.
My questions is will the following code work. I have a textbox(for numbers) and combobbox(for letters)
Dim sha As String
Dim stringposition As Long
Dim EngNumber As Long
sha = "abcdefghifjklmnopqrstuvwxyz"
stringposition = InStr(1, sha, Mid(1, cmbEngletter.Text, 1))
MsgBox "stringposition"
EngNumber = (txtManuNo.Text * 10) + stringposition
My only question above would be will the multiplication work with a .text. I believe it won't because it is a string. Please advise then on how to deal with a situation.
You can use CLng() to convert a string to a Long variable
CLng() will throw an error though if it doesn't like the contents of the string (for example if it contains a non-numeric character), so only use it when you are certain your string will only contain numbers
More forgiving is it to use Val() to convert a string into a numeric variable (a Double by default)
I also suggest you look into the following functions:
Asc() : returns the ASCII value of a character
Chr$() : coverts an ASCII value into a character
Left$() : returns the first characters of a string
CStr() : convert a number into a string
I think in your code you mean to show the contents of your variable stringposition instead of the word "stringposition", so you should remove the ""
I do wonder though what you are trying to accomplish with your code, but applying the above to your code gives:
Dim sha As String
Dim stringposition As Long
Dim EngNumber As Long
sha = "abcdefghifjklmnopqrstuvwxyz"
stringposition = InStr(1, sha, Left$(cmbEngletter.Text, 1))
MsgBox CStr(stringposition)
EngNumber = (Val(txtManuNo.Text) * 10) + stringposition
I used Val() because I am not certain your txtManuNo will contain only numbers
To ensure an user can only enter numbers you can use the following code:
Private Sub txtManuNo_KeyPress(KeyAscii As Integer)
Select Case KeyAscii
Case vbKeyBack
'allowe backspace
Case vbKey0 To vbKey9
'allow numbers
Case Else
'refuse any other input
KeyAscii = 0
End Select
End Sub
An user can still input non-numeric charcters with other methods though, like copy-paste via mouse actions, but it is a quick and easy first filter

Imploding an array into a string using VB

I'm extremely unfamiliar with ancient VB, and I'm trying to figure out the proper commands to concatenate an array (I am assuming it is in array form) into a string with comma separated values.
The values are being provided by a multiselect box, which is being assigned to the areas variable, which is grabbed from the areas select box.
dim name
dim from
dim company
dim phone
dim zip
dim message
dim areas
name = Request.Form("name")
from = Request.Form("from")
company = Request.Form("company")
phone = Request.Form("phone")
zip = Request.Form("zip")
areas = Request.Form("areas")
message = Request.Form("message")
I want to take areas, and implode it into a string.
What's the command in very old VB to do this?
The Join function does also exist in VB6, the syntax is like this:
myString = Join(myArray, ",")
EDIT: Note that the array goes before the delimiter. The delimiter is optional, it'll be a space if left empty.
you want to use the Join function String.Join(",",array)
If you are using VB6, try this:
Join(New String() {name, from, company}, ", ")
Join Function (Visual Basic) # MSDN
EDIT: I know it's a link to VB.NET, but it's the old VB6 function call, it should be compatible with VB6, syntax wise.

Copy most recent file from a batch of alike files using vbscript

I am not sure if this is possible or not. I am not even sure where to begin. I have a couple thousand files where the file names are named as so:
nnnnnnnnnnnnnnnn.yyyyddmm.pdf (n = number, yyyy = year, dd = day, and mm = month).
Within these thousands of files, there are batches of alike files that have the same nnnnnnnnnnnnnnnnnn part of the filename but the .yyyyddmm is different in order to represent the date of the file. (These batches of alike files will be merged together at a later point but that is not important to this scenario).
My question is, Is there a way to compare the yyyyddmm part of the alike files and have the most recent date files get copied to a different folder? I need the file that has the most recent date of the alike files on the filename get copied to a different folder.
The reason that I am having issues with this is because I am not sure if it is possible to compare parts of the filename to see which one is in fact the file that has the most recent date. I know that there is a way that this can be done through looking at the date modified date but this will not always give me the alike file with the most recent date.
Any thoughts?? Please let me know if I could provide more information.
Trying to understand your problem/specs. Assume a loop over the files of your .pdf folder results in:
Looking at "0000000000012345.20120402.pdf"
Looking at "0000000000012345.20120502.pdf"
Looking at "0000000000012348.20121702.pdf"
Looking at "0000000000012346.20120802.pdf"
Looking at "0000000000012347.20121002.pdf"
Looking at "0000000000012348.20121602.pdf"
Looking at "0000000000012347.20121302.pdf"
Looking at "0000000000012347.20121202.pdf"
Looking at "0000000000012345.20120202.pdf"
Looking at "0000000000012348.20121502.pdf"
Looking at "0000000000012346.20120602.pdf"
Looking at "0000000000012346.20120902.pdf"
Looking at "0000000000012348.20121402.pdf"
Looking at "0000000000012346.20120702.pdf"
Looking at "0000000000012347.20121102.pdf"
Looking at "0000000000012345.20120302.pdf"
Would
Last file for 0000000000012345 is 0000000000012345.20120502.pdf
Last file for 0000000000012348 is 0000000000012348.20121702.pdf
Last file for 0000000000012346 is 0000000000012346.20120902.pdf
Last file for 0000000000012347 is 0000000000012347.20121302.pdf
identify the files to copy correctly? If yes, say so and I will post the code here.
First, you need a class to obtain and store the info put into the file names:
' cut & store info about file(names) like "0000000000012347.20121202.pdf"
Class cCut
Private m_sN ' complete file name
Private m_sG ' group/number prefix part
Private m_dtF ' date part; converted to ease comparisons
Public Function cut(reCut, sFiNa)
Set cut = Me ' return self/this from function
Dim oMTS : Set oMTS = reCut.Execute(sFiNa)
If 1 = oMTS.Count Then
m_sN = sFiNa
Dim oSM : Set oSM = oMTS(0).SubMatches
m_sG = oSM(0)
m_dtF = DateSerial(oSM(1), oSM(3), oSM(2))
Else
' Err.Raise
End If
End Function ' cut
Public Property Get G() : G = m_sG : End Property ' G
Public Property Get D() : D = m_dtF : End Property ' D
Public Property Get N() : N = m_sN : End Property ' N
End Class ' cCut
Then just loop over the .Files and check the date parts for each group stored in a dictionary (number prefix part used as key):
' The one and only .pdf folder - no recursion into subfolders!
Dim sTDir : sTDir = "..\data\test"
' dictionary to store the last/most recently used file for each group
Dim dicG : Set dicG = CreateObject("Scripting.Dictionary")
' RegExp to cut/parse file names like "0000000000012345.20120402.pdf"
Dim reCut : Set reCut = New RegExp
reCut.Pattern = "^(\d{16})\.(\d{4})(\d{2})(\d{2})\.pdf$"
Dim oFile
For Each oFile In goFS.GetFolder(sTDir).Files
WScript.Echo "Looking at", qq(oFile.Name)
' an oCut object for each file name
Dim oCut : Set oCut = New cCut.cut(reCut, oFile.Name)
If Not dicG.Exists(oCut.G) Then
' new group, first file, assume this is the latest
Set dicG(oCut.G) = oCut
Else
' found a better one for this group?
If dicG(oCut.G).D < oCut.D Then Set dicG(oCut.G) = oCut
End If
Next
WScript.Echo "-----------------------"
Dim sG
For Each sG In dicG.Keys
WScript.Echo "Last file for", sG, "is", dicG(sG).N
Next
WRT comments:
All my (ad hoc/proof of concept) scripts start with
Option Explicit
Dim goFS : Set goFS = CreateObject( "Scripting.FileSystemObject" )
and contain some functions dealing with different aspects/stragegies for a solution to a common problem/topic. When I post code here, I copy/paste working/tested code out of the middle of a function frame like
' ============================================================================
goXPLLib.Add _
"useDic02", "use a dictionary (Mark II)"
' ----------------------------------------------------------------------------
' ============================================================================
Function useDic02()
useDic02 = 1 ' assume error
' The one and only .pdf folder - no recursion into subfolders!
...
Next
useDic02 = 0 ' success
End Function ' useDic02
(yes, there is a first attempt function "useDic()" that was guilty of storing all the oCuts for each group to be processed in a second loop; yes, there is a function "createTestData()" I needed to set up/fill my TDir). Sometimes I'm sloppy and forget about goFS, please accept my apologies.
The variable names are part of an experiment. I used to advocate type-prefixed long variable names upto and including
Dim nIdx
For nIdx = 0 To UBound(aNames)
aNames(nIdx) = ...
Next
Other people argued that nIdx-alikes variables just add some letters to mistype but no additional meaning over i, and that aNames-alikes can't be understood without the context and if you have that, aN would be a just as good remainder for "The first names of the kings of persia from the currently processed file to be compared to the names in the database".
So I thought: Given that there are 3 interesting aspects of a file name (full name to copy, number prefix to group, date part to compare/decide) and that there is half a screen between
Private m_sN ' complete file name
and
Public Property Get N() : N = m_sN : End Property ' N
and given that you need just those 3 properties of the Cut object to use it in
Dim oCut : Set oCut = New cCut.cut(reCut, oFile.Name)
If Not dicG.Exists(oCut.G) Then
' new group, first file, assume this is the latest
Set dicG(oCut.G) = oCut
Else
' found a better one for this group?
If dicG(oCut.G).D < oCut.D Then Set dicG(oCut.G) = oCut
will the average short time memory cope with oCut.D?
Obviously not.
To copy the selected files:
Assuming you want the files copied to an existing folder "..\data\latest", use
goFS.CopyFile goFS.BuildPath(sTDir, dicG(sG).N), "..\data\latest\", True
instead of/in addition to the line
WScript.Echo "Last file for", sG, "is", dicG(sG).N
I did not anticipate that .CopyFile chokes on relative source pathes; so consider replacing the *N*ame property of the cCut class with a *P*ath property.
Trying to use
dicG(sG).Copy "..\data\latest\", True
results in:
Microsoft VBScript runtime error: Object doesn't support this property or method: 'dicG(...).Copy'
because the objects stored aren't files (which have a .Copy method), but cCuts (which don't).
How I would handle it:
I would make a dictionary with for each unique number part a separate key. The value will be an array with all file names sharing that key (and thus sharing the unique number part)
For each key in the dictionary, I will loop through the items in the array, searching for the most recent date.
Approach:
Get a file
Extract number part
See if a key for that number part exist. If not create a key for that number with an empty array as value
Add the filename as a new item to the array
Loop to 1. until all files are handled
Get a key
Get the first file in the attached array. Remember the date and the arrayindex
Get the next file, if the date is higher than the remembered date, update the date to this date and the arrayindex to this array index
Loop to 8. until the end of the array is reached
Store the file with the arrayindex as the most recent file for that unique number
loop to 6. until all keys are handled

populating ADODB command Binary parameters in VB6

I need to modify someone else's VB code, and I don't have much experience with VB6.
I need to call a SQL2000 stored procedure using ADODB. One of the parameters is of type Binary and it's giving me problems. Every time I create the parameter, I get an error "Application uses a value of the wrong type for the current operation". The error happens at the cmd.parameter.append line, it doesn't even give me a chance call the cmd.execute.
Dim HexPassword As String
Dim BinPassword As String
Dim AsciiCode As Integer
Dim unitDigit As String
Dim TensDigit As String
Set obj_hash = New EDCrypt
' Returns Hash of password hex encoded
HexPassword = obj_hash.GetTextHash(Trim(txtPassword.text), haSHA1)
' Converts Hex Encoded string to Binary encoded string
Dim i As Integer
For i = 1 To 40 Step 2
unitDigit = Mid(HexPassword, i + 1, 1)
TensDigit = Mid(HexPassword, i, 1)
AsciiCode = HexStrtoInt(TensDigit + unitDigit)
BinPassword = BinPassword + Chr(AsciiCode)
Next i
conn.Open ConnectionString
Dim cmd As ADODB.Command
Set cmd = New ADODB.Command
Set cmd.ActiveConnection = conn
cmd.CommandType = adCmdStoredProc
cmd.CommandText = "ValidatePasswordNew"
cmd.Parameters.Append cmd.CreateParameter("LoginID", adVarChar, adParamInput, 30, UserID)
cmd.Parameters.Append cmd.CreateParameter("ShaPassword", adBinary, adParamInput, 20, BinPassword)
Try this for your string concatenation:
BinPassword = BinPassword & ChrB(AsciiCode)
+ is not the right string concatenation operator, and using ChrB should convince VB and ADO that you're really passing it binary data, not character data.
There's also a chance DOK is right about the size. You can try setting the size to something you're certain is longer than you need, or you can probably get around setting the size at all by splitting the operation into two statements:
cmd.Parameters.Append cmd.CreateParameter("ShaPassword", adBinary, adParamInput)
cmd.Parameters("ShaPassword").Value = BinPassword
It's weird, but it's worked for me in the past.
Just for added emphasis in case someone sees this again: the size property on Parameter objects does not have to match the exact byte length of your argument; it merely has to be at least big enough to hold your argument.
I think the problem may be in setting size = 20. That may be an optional argument. Try leaving it out. There might be a different overload of CreateParameter that you need to use here.
Check out this MSDN page which gives this general pattern:
command.CreateParameter (Name, Type, Direction, Size, Value)
Also, you have declared BinPassword as a String. You can't pass a string into a parameter of adBinary. You need to pass a binary object into that, or change adBinary to adVarChar.
You probably want adVarBinary. Most likely you should be passing Byte arrays as values.

Resources