Formatting just one line vb6 word 2007 bar code - vb6

I am automating a word document with a single table, using vb6. I have the following:
strCellContents = "s " & CStr(oRec("sphBase")) & " c " & CStr(oRec("cylAdd")) & vbCrLf
strCellContents = strCellContents & oRec("Description") & vbCrLf
strCellContents = strCellContents & "1010" & CStr(oRec("RightOPC")) & vbCrLf
strCellContents = strCellContents & "1010" & CStr(oRec("RightOPC")) & vbCrLf
oDoc.Tables(1).Range.ParagraphFormat.SpaceBefore = 6
oDoc.Tables(1).Range.ParagraphFormat.SpaceAfter = 0
oDoc.Tables(1).Range.ParagraphFormat.LineSpacing = InchesToPoints(0.11)
oDoc.Tables(1).Cell(row, col).Range.Text = strCellContents
If Not oRec.EOF Then
oRec.MoveNext
End If
You will note I repeat one of the lines twice, giving me four lines of text in each of 30 cells (3 cols 10 rows). I want the first instance of the repeated line to have a bar code font. How would I go about formatting just that line? I have the bar code font and it is installed.

I found the answer
iNumWords = oDoc.Tables(1).Range.Words.Count
''modify font of bar code (3rd line) - underline for now
For q = 1 To iNumWords
If CStr(oDoc.Tables(1).Range.Words(q)) = strSKU Then
oDoc.Tables(1).Range.Words(q).Font.Underline = wdUnderlineSingle
Exit For
End If
Next

Related

Multi-line text in VBScript

Is there a way to do multiline text via VBScript popups?
I'm trying to do some ASCII art via VBScript. Here's my code:
X = MsgBox("⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣀⡀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣶⣿⣿⣿⣿⣿⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⠿⠟⠛⠻⣿⠆⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣆⣀⣀⠀⣿⠂⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠻⣿⣿⣿⠅⠛⠋⠈⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠘⢼⣿⣿⣿⣃⠠⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣟⡿⠃⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣛⣛⣫⡄⠀⢸⣦⣀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣠⣴⣾⡆⠸⣿⣿⣿⡷⠂⠨⣿⣿⣿⣿⣶⣦⣤⣀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣤⣾⣿⣿⣿⣿⡇⢀⣿⡿⠋⠁⢀⡶⠪⣉⢸⣿⣿⣿⣿⣿⣇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⣿⣿⣿⣿⣿⡏⢸⣿⣷⣿⣿⣷⣦⡙⣿⣿⣿⣿⣿⡏⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⣿⣿⣿⣿⣿⣿⣿⣿⣇⢸⣿⣿⣿⣿⣿⣷⣦⣿⣿⣿⣿⣿⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡇⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣄⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡿⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⠃⠀⠀⠀⠀⠀⠀⠀⠀⠀
⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢹⣿⣵⣾⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣯⡁⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀
", 0+64, "Get Rickrolled")
Here's one way to do it in a single file. Note: This must be saved as Unicode (UTF-16):
z = vbCRLF
PicData = _
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣶⣿⣿⣿⣿⣿⣄" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⠿⠟⠛⠻⣿⠆" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣆⣀⣀⠀⣿⠂" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠻⣿⣿⣿⠅⠛⠋⠈" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠘⢼⣿⣿⣿⣃⠠" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣟⡿⠃" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣛⣛⣫⡄⠀⢸⣦⣀" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣠⣴⣾⡆⠸⣿⣿⣿⡷⠂⠨⣿⣿⣿⣿⣶⣦⣤⣀" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣤⣾⣿⣿⣿⣿⡇⢀⣿⡿⠋⠁⢀⡶⠪⣉⢸⣿⣿⣿⣿⣿⣇" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⣿⣿⣿⣿⣿⡏⢸⣿⣷⣿⣿⣷⣦⡙⣿⣿⣿⣿⣿⡏" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⣿⣿⣿⣿⣿⣿⣿⣿⣇⢸⣿⣿⣿⣿⣿⣷⣦⣿⣿⣿⣿⣿⡇" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡇" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣄" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡿" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⠃" & z &_
"⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢹⣿⣵⣾⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣯⡁"
MsgBox PicData, 0+64, "Get Rickrolled"
Or you can put the ASCII art in a separate file and then read it in and display it.
If you save the art as Unicode (UTF-16), use this code:
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile(".\Pic.txt", 1, , -1)
PicData = oFile.ReadAll
oFile.Close
MsgBox PicData, 0+64, "Get Rickrolled"
If you save the art as UTF-8, use this code:
Set oADO = CreateObject("ADODB.Stream")
oADO.CharSet = "UTF-8"
oADO.Open
oADO.LoadFromFile(".\Pic.txt")
PicData = oADO.ReadText()
oADO.Close
MsgBox PicData, 0+64, "Get Rickrolled"
Or put the ASCII art at the beginning of the script, as commented lines, and then read the script itself line by line until an end marker is found. Save the script as Unicode (UTF-16):
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣶⣿⣿⣿⣿⣿⣄
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⠿⠟⠛⠻⣿⠆
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣆⣀⣀⠀⣿⠂
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⠻⣿⣿⣿⠅⠛⠋⠈
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠘⢼⣿⣿⣿⣃⠠
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣟⡿⠃
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣛⣛⣫⡄⠀⢸⣦⣀
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣠⣴⣾⡆⠸⣿⣿⣿⡷⠂⠨⣿⣿⣿⣿⣶⣦⣤⣀
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣤⣾⣿⣿⣿⣿⡇⢀⣿⡿⠋⠁⢀⡶⠪⣉⢸⣿⣿⣿⣿⣿⣇
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢀⣿⣿⣿⣿⣿⣿⣿⣿⡏⢸⣿⣷⣿⣿⣷⣦⡙⣿⣿⣿⣿⣿⡏
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠈⣿⣿⣿⣿⣿⣿⣿⣿⣇⢸⣿⣿⣿⣿⣿⣷⣦⣿⣿⣿⣿⣿⡇
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡇
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣄
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠸⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣠⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⡿
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⠃
'⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⠀⢹⣿⣵⣾⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣿⣯⡁
'EOF
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oFile = oFSO.OpenTextFile(WScript.ScriptFullName, 1, , -1)
Do Until oFile.AtEndOfStream Or Line = "'EOF"
PicData = PicData & Mid(Line, 2) & vbCRLF
Line = oFile.ReadLine
Loop
oFile.Close
MsgBox PicData, 0+64, "Get Rickrolled"
WScript.Quit
Note: If your ASCII art exceeds 1023 characters, you'll need to use WScript.Echo instead of MsgBox.

Is there a way to organize WriteLine output into columns in a text file?

Is there any way to separate the WriteLine data output in a text file into columns (ex: Date | Location | Size)?
I've yet to see any information regarding this anywhere online, unsure if possible since the data being written isn't static. Would I need an entirely different function in order to have the script handle the formatting of the text file?
Option Explicit
Dim sDirectoryPath,Search_Days,r_nr,iDaysOld,CmdArg_Object,lastModDate
Dim oFSO,oFolder,oFileCollection,oFile,oTF,Inp, SubFolder,fullpath
Set CmdArg_Object = Wscript.Arguments
Select Case (CmdArg_Object.Count)
Case 3
sDirectoryPath = CmdArg_Object.item(0)
Search_Days = CmdArg_Object.item(1)
r_nr = CmdArg_Object.item(2)
Case Else
WScript.Echo "SearchFiles.vbs requires 3 parameters:" & _
vbCrLf & "1) Folder Path" & _
vbCrLf & "2) # Days to Search" & _
vbCrLf & "3) Recursive option (r/nr)"
WScript.Quit
End Select
Set oFSO = CreateObject("Scripting.FileSystemObject")
iDaysOld=Date+(-1*Search_Days)
Inp = InputBox("Please Enter Desired Location of Log File:")
If Inp= "" Then
Set oTF = oFSO.CreateTextFile("C:\output.txt")
Else
Set oTF = oFSO.CreateTextFile(oFSO.BuildPath(Inp, "output.txt"))
End If
Set oFolder = oFSO.GetFolder(sDirectoryPath)
Set oFileCollection = oFolder.Files
WScript.Echo Now & " - Beginning " & Search_Days & " day search of " & sDirectoryPath
If r_nr = "r" Then
oTF.WriteLine ("Search Parameters-") & _
vbCrLf & "DirectoryPath: " & sDirectoryPath & _
vbCrLf & "Older than: " & Search_Days &" Days " & _
vbCrLf & "Recursive/Non-Recursive: " & r_nr & _
vbCrLf & "------------------ "
TraverseFolders oFSO.GetFolder(sDirectoryPath)
Function TraverseFolders (FolderName)
For Each SubFolder In FolderName.SubFolders
For Each oFile In SubFolder.Files
lastModDate = oFile.DateLastModified
If (lastModDate <= iDaysOld) Then
oTF.WriteLine (oFile.DateLastModified) & " " & oFile.Path
End If
Next
TraverseFolders(Subfolder)
Next
End Function
Else
oTF.WriteLine ("Search Parameters:") & _
vbCrLf & "DirectoryPath: " & sDirectoryPath & _
vbCrLf & "Older than: " & Search_Days &" Days " & _
vbCrLf & "Recursive/Non-Recursive: " & r_nr & _
vbCrLf & "------------------------- "
For Each oFile In oFileCollection
lastModDate = oFile.DateLastModified
If (lastModDate <= iDaysOld) Then
oTF.WriteLine (oFile.DateLastModified) & " " & oFile.Path
End If
Next
End If
If Inp = "" Then
WScript.Echo "Now - Finished! Results Placed in: C:\output.txt"
Else
WScript.Echo "Now - Finished! Results Placed in: " & Inp
End If
You could use a delimiter-separated output format, e.g. like this:
Delim = vbTab
oTF.WriteLine "DateLastModified" & Delim & "Size" & Delim & "Path"
...
For Each oFile in oFileCollection
oTF.WriteLine oFile.DateLastModified & Delim & oFile.Size & Delim & oFile.Path
Next
Using tabs and a carefully chosen order of fields has the advantage that editors will display the content in (mostly) proper columns and you can import it as CSV in other programs.
If you're aiming for a fixed-width format you need to pad the data yourself e.g. with custom padding functions, e.g.
Function LPad(s, l)
n = 0
If l > Len(s) Then n = l - Len(s)
LPad = String(n, " ") & s
End Function
Using a StringBuilder object would also be an option, as described in this answer to another question.

WScript.Echo output command in cmd

I need some assistance with outputting an error in CMD.
We have a timesheet system that is failing to add holidays into the users time sheets, it's done via a script. here is the portion of the script in question.
sql = "select h_user,h_date1,h_hrs,h_approved,hol_default from holidays,hol_type,logins_users where userid=h_user and h_type=hol_id and h_date1='" & today & "' order by h_type desc"
'WScript.Echo Sql
ar.Open Sql, cnn ', adOpenForwardOnly, adLockReadOnly, adCmdText
If Not (ar.EOF And ar.BOF) Then 'found some holidays
ar.movefirst()
While Not ar.EOF
count = count + 1
user = ar.Fields("h_user").Value
datestr = ar.Fields("h_date1").Value
hours = ar.Fields("h_hrs").Value
approved = ar.Fields("h_approved").Value
defaulthours = ar.Fields("hol_default").Value
If hours = 8 Then actualhours = defaulthours
If hours = 4 Then actualhours = defaulthours / 2
If hours = 0 Then actualhours = 0
sqlstr = "select * from timesheets where ts_user=" & user & " and ts_hrs in(" & hours & "," & defaulthours &") and ts_date='" & today & "' and ts_job=20"
ar1.Open sqlstr, cnn
If Not (ar1.EOF And ar1.BOF) Then
'record exists
sqlstr = "update timesheets set ts_eduser=0,ts_eddate=now() where ts_user=" & user & " and ts_hrs=" & actualhours & " and ts_date='" & today & "' and ts_job=20"
Else
'no record
sqlstr = "insert into timesheets (ts_user,ts_date,ts_hrs,ts_approved,ts_job,ts_cruser,ts_crdate) values (" & user & ",'" & today & "'," & actualhours & "," & approved & ",20,0,Now())"
End If
ar1.Close()
cnn.Execute("insert into tracking (t_user,t_query) values (0,'" & addslashes(sqlstr) & "')")
cnn.Execute(sqlstr)
ar.MoveNext()
Wend
End If
ar.Close
Next
message = message & count & " holidays entries added" & vbCrLf
count = 0
Set ar1 = Nothing
Set ar2 = Nothing
Set ar1 = CreateObject("ADODB.RecordSet")
Set ar2 = CreateObject("ADODB.RecordSet")
For n = 0 To 28
daystr = DateAdd("d", n, Now())
today = Mid(daystr, 7, 4) & "-" & Mid(daystr, 4, 2) & "-" & Left(daystr, 2)
What I need to do is specifically output the results of defaulthours in a cmd window to allow me to inspect the error in the data it's retrieving.
I realise it's a WScript.Echo command but I've tried several variations and it stops the script from running.
Could someone point me in the right direction?
Run the script with cscript.exe instead of the default interpreter (wscript.exe).
cscript //NoLogo C:\path\to\your.vbs
cscript.exe prints WScript.Echo messages to the console instead of displaying message popups.
Alternatively you could replace WScript.Echo with WScript.StdOut.WriteLine, which will require cscript and raise an error otherwise (because WScript.StdOut is not available in wscript).

How to use datagrid in sending an sms to each value in a row in a specific column. VB6

I'm new to Vb6. I just want to know how to use my sms code to send all the numbers in the rows in a specific column. In this code, the messages i received are more than what i want to receive. Please help me fix my looping method.
Dim x As String
Dim e As Integer
Dim allcontacts As String
For i = 0 To DataGrid1.VisibleRows
For e = 0 To DataGrid1.ApproxCount - 1
allcontacts = DataGrid1.Columns(5).CellValue(DataGrid1.GetBookmark(e))
' Send an 'AT' command to the phone
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF=1" & vbCrLf 'This line can be removed if your modem will always be in Text Mode...
Sleep 500
MSComm1.Output = "AT+CMGS=" & Chr(34) & allcontacts & Chr(34) & vbCrLf 'Replace this with your mobile Phone's No.
Sleep 1000
MSComm1.Output = "From School Activities Management System: " & vbCrLf & vbCrLf & "The time now is " & Label3.Caption & vbCrLf & vbCrLf & "Announcement:" & vbCrLf & Text1.Text & Chr(26)
Sleep 2000
Next e
Next i
x = DataGrid1.VisibleRows
MsgBox "Message Sent to " + x + " contacts in faculty."
End Sub
Here's a screenshot of the datagrid:
Based upon your screenshot, it looks like you want to send 1 sms for each row. Therefore, I would try the following code:
Dim i As Integer
Dim allcontacts As String
For i = 0 To DataGrid1.VisibleRows - 1
allcontacts = DataGrid1.Columns(5).CellValue(DataGrid1.GetBookmark(i))
' Send an 'AT' command to the phone
MSComm1.Output = "AT" & vbCrLf
Sleep 500
MSComm1.Output = "AT+CMGF=1" & vbCrLf 'This line can be removed if your modem will always be in Text Mode...
Sleep 500
MSComm1.Output = "AT+CMGS=" & Chr(34) & allcontacts & Chr(34) & vbCrLf 'Replace this with your mobile Phone's No.
Sleep 1000
MSComm1.Output = "From School Activities Management System: " & vbCrLf & vbCrLf & "The time now is " & Label3.Caption & vbCrLf & vbCrLf & "Announcement:" & vbCrLf & Text1.Text & Chr(26)
Sleep 2000
Next i
MsgBox "Message Sent to " & DataGrid1.VisibleRows & " contacts in faculty."
One thing to keep in mind is that messages will only be sent for those rows that are visible on the screen. If they are scrolled off the screen and can't be seen then no message will be sent.

Shapes.AddPicture adds only the last image - Excel VB macro for Mac

I have an excel macro, which populate images in an excel sheet from a server.
While this is straight forward for windows, for Mac, I get the images using the "curl" command, copy it over to a local folder ( if the imaage is existing), and use Shapes.AddPicture to insert the image and then delete the local image. For a single picture, this works great. But when I have to select a few columns and add multiple images, it only adds the last image. Can someone tell me why and how to fix this?
Below is the relevant code
=====================================
For Each objCell In objSelectedRange
If objCell.Value <> "" Then
UserPath = UserPath & "/" & objCell.Value & ImageType ' Add prefix and filename
ImagePath = ImageFolder & objCell.Value & ImageType
FTPpathtofile = ImagePath
scriptToCheck = "tell application " & Chr(34) & "Finder" & Chr(34) & " to do shell script " & Chr(34) & "curl " & FTPpathtofile & Chr(34)
retCode = MacScript(scriptToCheck)
str = (InStr(retCode, "404"))
If (str = 0) Then
scriptToRun = "tell application " & Chr(34) & "Finder" & Chr(34) & " to do shell script " & Chr(34) & "curl " & FTPpathtofile & " >" & UserPath & Chr(34)
MacScript (scriptToRun)
With ActiveSheet
PathtoHD = MacScript("path to startup disk as string")
localImagePath = Replace(UserPath, "/", ":")
localImagePath = PathtoHD & localImagePath
Set objImgMac = .Shapes.AddPicture(localImagePath, True, True, objCell.Left, objCell.Top, 30, 60)
If adjustCell Then
objCell.RowHeight = 78
If objCell.ColumnWidth < 12 Then
objCell.ColumnWidth = 12
End If
End If
If vAlign = "Top" Then
objCell.VerticalAlignment = xlVAlignTop
objImgMac.Top = objCell.Top + 15
objImgMac.Left = objCell.Left + 5
Else
If vAlign = "Bottom" Then
objCell.VerticalAlignment = xlVAlignBottom
objImgMac.Top = objCell.Top + 5
objImgMac.Left = objCell.Left + 5
End If
End If
End With
'delete file from the folder
DeleteFileOnMac (localImagePath)
End If
End If
Next objCell
=============================
You have
UserPath = UserPath & "/" & objCell.Value & ImageType
within your loop, but you don't seem to ever reset the value of UserPath between iterations, so it will just accumulate content.

Resources