how to assign XML values to string in Vb6 - vb6

I want to assign below mentioned xml values to a string like this
Dim test As String
test = ... ?
Where the XML should contain:
<RptVer>1</RptVer>
<RptTyp>1</RptTyp>
</RptInfo>
</InstRptRoot>
How can I do this and also preserve the formatting (ie linebreaks, spacing, etc.)?

Mark answered your question, I'll answer your second question:
Dim test As String
test = "<RptInfo>" & vbCrLf & vbCrLf & _
vbTab & "<RptVer>1</RptVer>" & vbCrLf & vbCrLf & _
vbTab & "<RptTyp>1</RptTyp> & vbCrLf & vbCrLf & _
"</RptInfo>"
Assuming you want it double-spaced and indented. You had also missed the leading tag, but MarkL caught that as well.

Related

How to find string by filter in VBScript?

I have a problem here:
I have an text like this
a lot of html tags
MPI-START
Hello world!
Hello world 2!
MPI-END
a lot of html tags again
And somehow I need to get text between MPI-START and MPI-END
It can contains many lines and text so I need to get them all
I tried to search but there are nothing
Any ideas?
Also sorry for my english, i from Russia
UPD: That text what i needed contains in < p data-placeholder="Your story...">TEXT</ p>
Ok, i found answer
Not perfect but works
Dim strid, outstr
strid = "many hell tags MPI-START" & vbNewLine & "Hello World!" & vbNewLine & "Hello World 2 !" & vbNewLine & "MPI-END there too"
outstr = Split (strid, "MPI-START")(1)
outstr = Split (outstr, "MPI-END")(0)
MsgBox outstr
Here is another approch using RegEx in vbscript to extract data between two delimiters :
Option Explicit
Dim Full_String,First_Delimiter,Second_Delimiter,Extracted_Data
Full_String = "a lot of html tags" & vbNewLine &_
"< p data-placeholder=""Your story..."">" & vbNewLine &_
"Hello world!" & vbNewLine &_
"Hello world 2!" & vbNewLine &_
"</ p>" & vbNewLine &_
"a lot of html tags again"
wscript.echo Full_String
First_Delimiter = "< p data-placeholder=""Your story..."">"
Second_Delimiter = "</ p>"
Extracted_Data = ExtractData(Full_String,First_Delimiter,Second_Delimiter)
wscript.echo Extracted_Data
'------------------------------------------------------------------------------------------------
Function ExtractData(Full_String,Start_Delim,End_Delim)
Dim r,Matches,Data
Set r=new regexp
r.pattern = "(?:^|(?:\r\n))(:?"& Start_Delim &"\r\n)([\s\S]*?)(?:\r\n)(?:"& End_Delim &")"
Set Matches = r.Execute(Full_String)
If Matches.Count > 0 Then Data = Matches(0).SubMatches(1)
ExtractData = Data
End Function
'------------------------------------------------------------------------------------------------

Does VB6 InputBox support a multi-line string?

When using InputBox in Visual Basic 6 can I input a multiline string?
strSrch = InputBox("Enter word(s) or phrase(s), like " & Chr(34) & "Jesus wept" & _
Chr(34) & " to search for any word or phrase" & vbCrLf & _
"If you place & between words the verse must contain both words, loved & world" & _
vbCrLf & "or both phrases, " & Chr(34) & "keep the commandments" & Chr(34) & _
" & " & Chr(34) & "of Jesus" & Chr(34) & vbCrLf & "Put ! in front of a word or phrase to exclude it from your search, Jesus ! testimony" & _
vbCrLf & "Use( before and ) after expressions to group them together, (" & Chr(34) & _
"Come unto me" & Chr(34) & " & all)" & vbCrLf & "Use Xor between two words to include one or the other but not both, " & _
Chr(34) & "I am" & Chr(34) & " Xor that", "Word Search")
No, not really. IIRC, the InputBox should preserve any newline chars that are dropped into it via a paste or entered via ALT+###. But, they will appear as spaces in the box.
It will only ever appear on a single line. There's no real way to use an InputBox to let a user enter multiple lines.
The most feature-capable way to handle this would be to create a custom form and use it to collect user input. You can make it a modal dialog to force the user to interact with it, similar to an InputBox. There are a few ways to pass the input back to the procedure that displayed the form (such as using a global variable).

vbs passing parameters weird behavior

i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right record(would be one ID for each record in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below. The weird thing here is that if i double click it again it will refresh and open the right record without opening anymore windows..
How can i fix that? I dont want to do it twice :)
Public Sub sendMRBmail(mrbid)
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr (34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
Found the problem. Changed instruction below, adding acFormEdit to it and it worked:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit

VBS End of the statement expected error in

strCode = "Private Sub AcclvsTime() " & vbCr _
& "Set myChtObj = oExcelWriteWorkSheet.ChartObjects.Add(100,375,75,225) "& vbCr _
& "myChtObj.Chart.ChartType = 4 " & vbCr _
& "myChtObj.Chart.SetSourceData objWriteWorkbook.Sheets("sheet2").Range("A1:B15")" & vbCr _
& "End Sub"
objWriteExcel.VBE.ActiveVBProject.VBComponents.Item("Sheet1").CodeModule.AddFromString(strCode)
When I executed this code i got the error “end of the statement expected in line 4” (& "myChtObj.Chart.SetSourceData objWriteWorkbook.Sheets("sheet2").Range("A1:B15")" & vbCr _)
Can any one help me where is the mistake?
#paxdiablo: I would comment, but don't see a comment button.
Notice, though, the second quote from Range("A1:B15")" & vbCr is started from "myChtObj.Chart.SetSourceData
Having the full block of code would help better, as we can't tell what kind of end statement you will need. I.e, your "End Sub" is in double quotes. If that's the end of the sub, you need to take them out.
Building strings by concatenation is cumbersome and errorprone. Especially, if the result is a multiline string, use Join:
strCode = Join( Array( _
"Private Sub AcclvsTime()" _
, " Set myChtObj = oExcelWriteWorkSheet.ChartObjects.Add(100,375,75,225)" _
, " myChtObj.Chart.ChartType = 4" _
, " myChtObj.Chart.SetSourceData objWriteWorkbook.Sheets(""sheet2"").Range(""A1:B15"")" _
, "End Sub" _
), vbCrLf)
WScript.Echo strCode
output:
Private Sub AcclvsTime()
Set myChtObj = oExcelWriteWorkSheet.ChartObjects.Add(100,375,75,225)
myChtObj.Chart.ChartType = 4
myChtObj.Chart.SetSourceData objWriteWorkbook.Sheets("sheet2").Range("A1:B15")
End Sub
to reduce the noise caused by & and the repeating stuff vbCr(Lf). That will improve your chances to see the problems/mistakes. (Exactly two literals - "sheet2", "A1:B15" - to quote).
Addional Remark:
Given that the culprit is:
"whatever("sheet2").Range("A1:B15")"
it is obvious, that remedy
"whatever(""sheet2"").Range(""A1:B15"")"
is easier to read/check/write and less errorprone than
"whatever(" & Chr(24) & "sheet2" & Crh(34) & ").Range(" & Chr(34) + "A1:B15" & Chr(32) & ")"
Avoiding "" in literals by splicing in & Chr(34) &s is a bad strategy.
" ... Range("A1:B15")" & vbCr
Note those quotes within quotes on your fourth line (for both "sheet2" and "A1:B15") - you need to fix that.
If you want to put quotes within quotes, you can do it thus, by escaping. Two consecutive " characters within a double-quoted string will be translated to a single ".
"the word ""xyzzy"" is quoted"
Alternatively, you can also use chr(34) to get the quote:
"the word " & chr(34) & "xyzzy" & chr(34) & " is quoted"
This may be preferable in more complex cases, though I've rarely had a need for it.

Adding a summary report and disk information to VB Script

I was hoping someone could help me with this code. I wanted to add two things to this script but can't seem to get it working at all.
The script works fine but what isn't working is trying to add the disk information and trying to create a summary report for total size of disk.
at the end of it I'm trying to make an output of what
wmic diskdrive list brief /format:list
would give you.
something like this:
Caption=WDC WD2500BEKT-75PVMT1
DeviceID=\\.\PHYSICALDRIVE0
Model=WDC WD2500BEKT-75PVMT1
Partitions=1
Size=250056737280
Here is the script so far
Option Explicit
const strComputer = "."
const strReport = "c:\path\to\file"
Dim objWMIService, objItem, colItems
Dim strDriveType, strDiskSize, txt
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_LogicalDisk WHERE DriveType=3")
txt = "Drive" & vbtab & "Size" & vbtab & "Used" & vbtab & "Free" & vbtab & "Free(%)" & vbcrlf
For Each objItem in colItems
DIM pctFreeSpace,strFreeSpace,strusedSpace
pctFreeSpace = INT((objItem.FreeSpace / objItem.Size) * 1000)/10
strDiskSize = Int(objItem.Size /1073741824) & "Gb"
strFreeSpace = Int(objItem.FreeSpace /1073741824) & "Gb"
strUsedSpace = Int((objItem.Size-objItem.FreeSpace)/1073741824) & "Gb"
txt = txt & objItem.Name & vbtab & strDiskSize & vbtab & strUsedSpace & vbTab & strFreeSpace & vbtab & pctFreeSpace & vbcrlf
Next
writeTextFile txt, strReport
wscript.echo "Report written to " & strReport & vbcrlf & vbcrlf & txt
' Procedure to write output to a text file
private sub writeTextFile(byval txt,byval strTextFilePath)
Dim objFSO,objTextFile
set objFSO = createobject("Scripting.FileSystemObject")
set objTextFile = objFSO.CreateTextFile(strTextFilePath)
objTextFile.Write(txt)
objTextFile.Close
SET objTextFile = nothing
end sub
The wmic call and your script do entirely different things. The former queries the Win32_DiskDrive class to gather information about the physical disks, whereas the latter queries the Win32_LogicalDisk class to gather information about the volumes.
You can reproduce the output of the wmic command with something like this:
Set wmi = GetObject("winmgmts://./root/cimv2")
For Each disk In wmi.ExecQuery("SELECT * FROM Win32_DiskDrive")
WScript.Echo "Caption=" & disk.Caption & vbNewLine _
& "DeviceID=" & disk.DeviceID & vbNewLine _
& "Model=" & disk.Model & vbNewLine _
& "Partitions=" & disk.Partitions & vbNewLine _
& "Size=" & disk.Size
Next
However, the size returned by this query is the raw capacity of the physical disk. At this level you can't distinguish if a block is "free" or "used". Those are concepts that apply to filesystems. On that level, a sector either does or doesn't contain one or more files or file fragments. It's "free" when it doesn't contain any file and "used" otherwise. On that level, you don't get any information about "partitions", though, because those exist on a lower level (partitions contain filesystems).
What you need to do is decide which information you actually want to report, and then choose the appropriate properties from the relevant WMI class(es).

Resources