I know this kind of topic is quite common, but I can't find an answer for my problem. Could anyone help me on why type mismatch error appears (the code works however):
Sub CreateEMail2()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Dim iCounter As Integer, x As Double
For iCounter = 5 To WorksheetFunction.CountA(Columns(13))
Email = Cells(iCounter, 13)
Subj = "Atgādinājums par parādu"
Msg = ""
Msg = Msg & "Klients: " & Cells(iCounter, 1) & "," & vbCrLf & vbCrLf
Msg = Msg & "Vēlamies atgādināt, ka uz epasta izsūtīšanas brīdi Jūsu kavētā parāda kopsumma sastāda EUR "
Msg = Msg & Cells(iCounter, 6).Text & "." & vbCrLf & vbCrLf
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
Next iCounter
End Sub
thanks!
Related
Is there any function in VBScript that returns the absolute URL when we have domain and the relative URL.
Suppose I have the domain example.com/ and the relative path home/index.html. When the 2 values are passed to the function, the result returned should be example.com/home/index.html
For example in Java, there's a resolve method which does this job. And suppose we pass the values example.com/ and example.com/home/index.html to the method, the method returns example.com/home/index.html
If you mean a Decomposition of an URL adress ? here is an example in vbscript :
Option Explicit
Dim adress,result,Title
Title = "Decomposition of an URL"
'Some examples for testing
'adress = "http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"
'adress = "ftp://ftp.microsoft.com/softlib/index.txt"
'adress = "http://www.google.com"
adress = InputBox( "Please input the http or the https address.", " What makes up a Url ?",_
"http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre")
result = Search(trim(adress))
MsgBox Title & " ( Uniform Resource Locator ) ==> URL : " & DblQuote(adress) & vbCrLf & vbCrLf & result,64,Title
'*******************************************************
Function Search(MyString)
Dim objet,correspondance,collection,pattern
pattern="^" & _
"(\w+):\/\/([^/:]+)" & _
"(:(\d+))?" & _
"(" & _
"\/" & _
"(" & _
"(" & _
"([^/]+)" & _
"\/" & _
")?" & _
"(" & _
"([^#]+)" & _
")?" & _
"(" & _
"(#(\w+)?)?" & _
")?" & _
")?" & _
")?" & _
"$"
Set objet = New RegExp
objet.Pattern = Pattern
objet.IgnoreCase = True
objet.Global = True
if objet.test(MyString) then
Set collection = objet.Execute(MyString)
Set correspondance = collection(0)
result = "Protocol = " & DblQuote(correspondance.SubMatches(0)) & VbCRLF & vbCrLf _
& "Domain = " & DblQuote(correspondance.SubMatches(1)) & VbCRLF & vbCrLf _
& "Port = " & DblQuote(correspondance.SubMatches(3)) & vbCrLf & vbCrLf _
& "Folder = " & DblQuote(correspondance.SubMatches(7)) & VbCRLF& vbCrLf _
& "File = " & DblQuote(correspondance.SubMatches(9)) & VbCRLF& vbCrLf _
& "Anchor = "& DblQuote(correspondance.SubMatches(12))
Search = result
else
Search = MsgBox("no match ===> no result found !",48,Title)
end if
End Function
'----------------------------------------------------------------
'Function to add double quotes into a variable
Function DblQuote(Str)
DblQuote = Chr(34) & Str & Chr(34)
End Function
'----------------------------------------------------------------
You can also use PowerShell to do this very easily.
$uri = "http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre"
[system.uri]$uri
And you can get as result like that :
AbsolutePath : /coursasp/sommaire.html
AbsoluteUri : http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre
LocalPath : /coursasp/sommaire.html
Authority : www.laltruiste.com:8080
HostNameType : Dns
IsDefaultPort : False
IsFile : False
IsLoopback : False
PathAndQuery : /coursasp/sommaire.html
Segments : {/, coursasp/, sommaire.html}
IsUnc : False
Host : www.laltruiste.com
Port : 8080
Query :
Fragment : #anchor
Scheme : http
OriginalString : http://www.laltruiste.com:8080/coursasp/sommaire.html#ancre
DnsSafeHost : www.laltruiste.com
IsAbsoluteUri : True
UserEscaped : False
UserInfo :
I am using HP (Microfocus) Quality Center 12.5 and designed a button using the toolbar in Workflow.
The following code pulls the first value from the RecordSet but not all values. How do I pull all values from the RecordSet and display it?
Sub searchDefects()
On Error Resume Next
Dim a
a = InputBox("Enter search query")
set TD1 = TDConnection
set com1 = TD1.command
com1.CommandText = "Select BG_BUG_ID FROM BUG WHERE BG_DESCRIPTION LIKE '%"
&a &"%'"
set rec1 = com1.Execute
Dim i
DIM msg
msg = ""
rec1.First
For i = 0 to rec1.RecordCount
msg = msg & "," & rec1.FieldValue(i) & ","
rec1.Next()
Next
MsgBox msg
On Error GoTo 0
End Sub
I found a solution after trial and error but still don't know the reason behind the root cause and how it is solving it. Any feedback is appreciated.
Sub SearchDefectsDescription()
On Error Resume Next
Dim a
a = InputBox("Enter search query for Description field")
set TD1 = TDConnection
set com1 = TD1.command
com1.CommandText = "Select BG_BUG_ID FROM BUG WHERE BG_DESCRIPTION LIKE '%" &a &"%'"
set rec1 = com1.Execute
Dim i
DIM msg
msg = "Bug ID" & vbnewline
rec1.First
If a = vbCancel Then
MsgBox "Search is cancelled"
Exit Sub
ElseIf Len(a) = 0 Then
MsgBox "Search input is empty, plesea try again."
Exit Sub
Else
For i = 0 to rec1.RecordCount
msg = msg & rec1.FieldValue(0) & rec1.FieldValue(1) & " "
rec1.Next()
Next
End If
MsgBox msg
On Error GoTo 0
End Sub
In a sample.csv file, which has fixed number of columns, I have to extract a particular field value and store it in a variable using VBScript.
sample.csv
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2345"
101,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
100|SN| 435624| serkasg| 15.353|
100|SN| 437825| serkasg| 15.353|"," 0 2346"
I want to parse the last two fields which are within double quotes and store them in two different array variables for each row.
You could try using an ADO connection
Option Explicit
dim ado: set ado = CreateObject("ADODB.Connection")
ado.ConnectionString = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=c:\txtFilesFolder\;Extended Properties=""text;HDR=No;FMT=Delimited"";"
ado.open
dim recordSet: set recordSet = ado.Execute("SELECT * FROM [samples.csv]")
dim field3, field4
do until recordSet.EOF
field3 = recordSet.Fields(3).Value
field4 = recordSet.Fields(4).Value
' use your fields here
recordSet.MoveNext
loop
recordSet.close
ado.close
You may have an issue if those fields are greater than 255 characters in length - if they are, they may return truncated. You also may have better luck with ODBC or ACE connection strings instead of the Jet one I've used here.
Since CSV's are comma-separated, you can use the Split() function to separate the fields into an array:
' Read a line from the CSV...
strLine = myCSV.ReadLine()
' Split by comma into an array...
a = Split(strLine, ",")
Since you have a static number of columns (5), the last field will always be a(4) and the second-to-last field will be a(3).
Your CSV data seems to contain 2 embedded hard returns (CR, LF) per line. Then the first line ReadLine returns is:
100,SN,100.SN,"100|SN| 435623| serkasg| 15.32|
The solution below unwraps these lines before extracting the required fields.
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Line, LineNo, Fields, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Line = ""
LineNo = 0
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Do While Not TextStream.AtEndOfStream
Line = Line & TextStream.ReadLine()
LineNo = LineNo + 1
If LineNo mod 3 = 0 Then
Fields = Split(Line, ",")
Field4 = Fields(3)
Field5 = Fields(4)
MsgBox "Line " & LineNo / 3 & ": " & vbNewLine & vbNewLine _
& "Field4: " & Field4 & vbNewLine & vbNewLine _
& "Field5: " & Field5
Line = ""
End If
Loop
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub
Here is an alternative solution that allows for single or multiline CSV records. It uses a regular expression which simplifies the logic for handling multiline records. This solution does not remove CRLF characters embedded in a record; I've left that as an exercise for you :)
Option Explicit
Const ForReading = 1
Const ForAppending = 8
Const TristateUseDefault = 2 ' Opens the file using the system default.
Const TristateTrue = 1 ' Opens the file as Unicode.
Const TristateFalse = 0 ' Opens the file as ASCII.
Dim FSO, TextStream, Text, MyRegExp, MyMatches, MyMatch, Field4, Field5
ExtractFields "sample.csv"
Sub ExtractFields(FileName)
Set FSO = CreateObject("Scripting.FileSystemObject")
If FSO.FileExists(FileName) Then
Set MyRegExp = New RegExp
MyRegExp.Multiline = True
MyRegExp.Global = True
MyRegExp.Pattern = """([^""]+)"",""([^""]+)"""
Set TextStream = FSO.OpenTextFile(FileName, ForReading, False, TristateFalse)
Text = TextStream.ReadAll
Set MyMatches = MyRegExp.Execute(Text)
For Each MyMatch in MyMatches
Field4 = SubMatches(0)
Field5 = SubMatches(1)
MsgBox "Field4: " & vbNewLine & Field4 & vbNewLine & vbNewLine _
& "Field5: " & vbNewLine & Field5, 0, "Found Match"
Next
Set MyMatches = Nothing
TextStream.Close()
Else
MsgBox "File " & FileName & " ... Not found"
End If
End Sub
I'm stuck on something that (I think) should be quite simple, but I can't work out how to do it. I can't find any information either here on SO or on Google.
We have a web app that takes data from our site and automatically POSTS this to another API.
We'd like to send over a binary file also - for example, we'd grab the file from a local URL and POST it's contents over to the other site.
Could anybody point me in the right direction for this? For example, would I need to embed the file URL in the data somehow and POST as multipart/form-data?
I created these Classic ASP function to POST a file to another server. Hopefully it will help you too.
Function PostDocument(intDocumentID, binFile, strFilename, strContentType)
Dim objHttp, strBoundary, strRequestStart, strRequestEnd, binPost
Dim objStream
strBoundary = "---------------------------9849436581144108930470211272"
Set objHttp = Server.CreateObject("MSXML2.ServerXMLHTTP.6.0")
strRequestStart = "--" & strBoundary & vbCrlf &_
"Content-Disposition: form-data; name=""id""" & vbCrlf &_
vbCrlf &_
intDocumentID & vbCrlf &_
vbCrlf &_
"--" & strBoundary & vbCrlf &_
"Content-Disposition: form-data; name=""file""; filename=""" & strFilename & """" & vbCrlf &_
"Content-Type: " & strContentType & vbCrlf &_
vbCrlf
strRequestEnd = vbCrLf & "--" & strBoundary & "--"
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Type = adTypeBinary '1
objStream.Mode = adModeReadWrite '3
objStream.Open
objStream.Write StringToBinary(strRequestStart)
objStream.Write binFile
objStream.Write StringToBinary(strRequestEnd)
objStream.Position = 0
binPost = objStream.Read
Response.Write binPost
objStream.Close
Set objStream = Nothing
objHttp.Open "POST", "(url removed)", False, "(username removed)", "(password removed)"
objHttp.setRequestHeader "Content-Type", "multipart/form-data; boundary=""" & strBoundary & """"
objHttp.Send binPost
PostDocument = objHttp.ResponseText
Set objHttp = Nothing
End Function
Function StringToBinary(toConvert)
Dim objStream, data
Set objStream = Server.CreateObject("ADODB.Stream")
objStream.Charset = "ISO-8859-1"
objStream.Type = adTypeText '2
objStream.Mode = adModeReadWrite '3
objStream.Open
objStream.WriteText toConvert
objStream.Position = 0
objStream.Type = adTypeBinary '1
StringToBinary = objStream.Read
objStream.Close
Set objStream = Nothing
End Function
This question follows an earlier one.
Here is some code that reproduces the problem:
POST:
str = "accountRequest=<NewUser>" & vbLf & _
"Hello" & vbTab & "World" & vbLf & _
"</NewUser>"
Set objHTTP = Server.CreateObject("Msxml2.ServerXMLHTTP.3.0")
objHTTP.open "POST", "service.asp", False
objHTTP.setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
objHTTP.send str
response.Write(objHTTP.responseText)
Set objHTTP = Nothing
service.asp:
function w (str)
response.Write(str & "<br>")
end function
str = request.Form("accountRequest")
w(str)
w("Tabs: "& InStr(str,vbTab))
w("Lines: "& InStr(str,vbLf))
output:
HelloWorld
Tabs: 0
Lines: 0
Can anyone please help?
Try:
Replace(Request.Form("accountRequest"), vbLF, vbCRLF))
Or:
Replace(Request.Form("accountRequest"), vbLF, "<br>"))|
Depending on where you're displaying it, either should work.
Or possibly this:
Function URLDecode(sConvert)
Dim aSplit
Dim sOutput
Dim I
If IsNull(sConvert) Then
URLDecode = ""
Exit Function
End If
' convert all pluses to spaces
sOutput = REPLACE(sConvert, "+", " ")
' next convert %hexdigits to the character
aSplit = Split(sOutput, "%")
If IsArray(aSplit) Then
sOutput = aSplit(0)
For I = 0 to UBound(aSplit) - 1
sOutput = sOutput & _
Chr("&H" & Left(aSplit(i + 1), 2)) &_
Right(aSplit(i + 1), Len(aSplit(i + 1)) - 2)
Next
End If
URLDecode = sOutput
End Function
From here: http://www.aspnut.com/reference/encoding.asp
If they are coming across the wire as the actual "\" and "n" characters, you can do a replace on those characters with the appropriate vbCRLF and vbTAB constants.
Finally figured out that ASP Request.Form method doesn't preserve tabs if they're in the "\t" format (as opposed to URL encoded). However, PHP's $_POST does.