My script will not enter either of the For loops, I have been using MsgBox to help check and it seems that it just skips over the entire loop without entering it.
"<<<" indicates where issue starts
'==========================================================
Sub Read
'======================================================
'Read Row
RR = 6
PC = 25
at this point the script is supposed to enter a loop which cycles through documents and files to read and store data
MsgBox "front For" <<<
For Cx = 1 to Cint(vTFileC)
MsgBox "in loop 1"
Cxx = 1
'Setting Target
Target = CStr(FullPath & "\" & vTFolder & "\"& vTFile & Cx &".html")
For x = Cxx to PC
MsgBox "in loop 2"
'Sets Book 1
set oBook1 = oExcel.Workbooks.Open(Target)
'Reading Table
set Stock = oExcel.Cells(RR,5)
set ID = oExcel.Cells(RR,3)
'Displays Info
MsgBox ( Cx &"/"& vTFileC &" RR: "& RR & " ID: " & ID & " Stock: " & Stock )
'Closes Book 1
oBook1.Close
MsgBox "3"
call Find_Write_Row
r = r + 1
Cxx = Cxx + 1
RR = RR + 1
Next
'to cycle to next document
Cx = Cx + 1
Next
This is where the script continues, jumping everything between here and the last section of non-code.
MsgBox "End"
'Quitting
oExcel.Quit
End Sub
'==========================================================
This is causing my script to run and then instantly close without doing anything.
This is the section of my script which sets some of the values being used
'==========================================================
' HTML INPUTS
'======================================================
'Sets Target folder from HTML input
set oTFolder = document.getElementById("Folder_")
vTFolder = oTFolder.value
'Sets Target file from HTML input
set oTFile = document.getElementById("File_")
vTFile = oTFile.value
'Sets file count from HTML input
set oTFileC = document.getElementById("C_")
vTFileC = oTFileC.value
'Toggles visibility of excel
set oVT = document.getElementById("VT")
vVT = oVT.value
'==========================================================
If For Cx = 1 to Cint(vTFileC) does not enter the loop, then Cint(vTFileC) evaluates to something that is less than 1. So vTFileC needs to be examined:
>> MsgBox TypeName(vTFileC)
>> MsgBox vTFileC
>> MsgBox CInt(vTFileC)
Related
I have 2 CSV files as shown below.
TEAMLIST.csv:
empid,name
54321,xyz
12345,abc
DATA.csv:
heading1,head2,head3,head4
54321-Process : GDPR_WBT,54321,Process : GDPR_WBT,TRUE
12345-Process : GDPR_WBT,12345,Process : GDPR_WBT,TRUE
54321-Fire Safety,54321,Fire Safety,FALSE
12345-Fire Safety,12345,Fire Safety,TRUE
Below is my entire VBScript code. The problem is that the inner loop is working fine but the outer loop is taking only the first record [54321,xyz] and not all records. Not able to understand why.
Option Explicit
Dim fs
Dim fs2
Set fs = CreateObject("Scripting.FileSystemObject")
Set fs2 = CreateObject("Scripting.FileSystemObject")
Dim EMPLOYEE
Dim DATA
Set EMPLOYEE = fs.OpenTextFile("TEAMLIST.csv")
Set DATA = fs2.OpenTextFile("DATA.csv")
Dim counter, line, EMP_ARRAY
Dim counter2, line2, DATA_ARRAY
counter = 0
counter2 = 0
Do While Not EMPLOYEE.AtEndOfStream
line = EMPLOYEE.ReadLine
counter = counter + 1
If counter > 1 Then
EMP_ARRAY = Split(line, ",")
Do While Not DATA.AtEndOfStream '### DATA LOOP STARTS ###
line2 = DATA.ReadLine
counter2 = counter2 + 1
If counter2 > 1 Then
DATA_ARRAY = Split(line2, ",")
If EMP_ARRAY(0) = DATA_ARRAY(1) Then
If DATA_ARRAY(2) = "Process : GDPR_WBT" Then
If DATA_ARRAY(3) = "" Then
DATA_ARRAY(3) = "FALSE"
End If
WScript.Echo EMP_ARRAY(0) & "--" & EMP_ARRAY(1) & "--" & DATA_ARRAY(2) & "--" & DATA_ARRAY(3)
End If
If DATA_ARRAY(2) = "Fire Safety" Then
If DATA_ARRAY(3) = "" Then
DATA_ARRAY(3) = "FALSE"
End If
WScript.Echo EMP_ARRAY(0) & "--" & EMP_ARRAY(1) & "--" & DATA_ARRAY(2) & "--" & DATA_ARRAY(3)
End If
End If
End If
Loop '### DATA LOOP ENDS ###
End If
Loop
EMPLOYEE.Close
DATA.Close
Set EMPLOYEE = Nothing
Set DATA = Nothing
Set fs = Nothing
Set fs2 = Nothing
After the first iteration of the outer loop the inner loop has already read DATA.csv to the end. To "rewind" that file for each iteration of the outer loop you need to open/close it inside the outer loop.
Do Until EMPLOYEE.AtEndOfStream
'...
Set DATA = fs.OpenTextFile("DATA.csv")
Do Until DATA.AtEndOfStream
'...
Loop
DATA.Close
Loop
Alternatively (if the file is sufficiently small) read it into an array once and have the inner loop iterate over that array.
DATA = Split(fs.OpenTextFile("DATA.csv").ReadAll, vbNewLine)
Do Until EMPLOYEE.AtEndOfStream
'...
For Each line2 In DATA
'...
Next
Loop
Side-note 1: creating multiple FileSystemObject instances in your script is pointless. Create a single instance at the beginning of your script and use that instance throughout the rest of the code.
Side-note 2: Do While Not is awkward. Use Do Until instead.
I've got a form with a subreport on it, which occasionally references / changes the recordsource of said report. This has been working perfectly for months. I recently went back and started tweaking a few things in it, namely the tab order. I added in some code that checks which button was used to open it and changes the tab order based on that. As soon as I started testing if this was working or not, the Error
"You entered an expression that has an invalid reference to the
property Form/Report"
started appearing on every line that references the report recordsource. I've tried removing the code I added before the error appeared but that didn't cause the error to go away.
Example of code that gets the error:
Me.rRAM10x10.Report.RecordSource = "tRAM10x10"
Code that I added right before the error started:
If CurrentProject.AllForms("fHighRisk").IsLoaded = True Then
If Screen.ActiveControl.Name = "btnRAMimpact" Then
Me.btnForFocus.TabIndex = 0
ElseIf Screen.ActiveControl.Name = "btnRAMlhood" Then
Me.Tabordertest.TabIndex = 0
End If
End If
I did some research and found that this can be caused by the parent form not having any records, but that is not the case here. Other than what I posted above, no changes have been made to this form, the report, or any of the tables I'm setting its recordsource to since I finished changing it months ago.
The OnOpen Event of the Form:
Private Sub Form_Open(Cancel As Integer)
Dim sID As Integer
If CurrentProject.AllForms("fRiskAssessmentTest").IsLoaded = True Then
sID = Forms!fRiskAssessmentTest!fHighRisk!ScenarioID.Value
ElseIf CurrentProject.AllForms("fHighRisk").IsLoaded = True Then
sID = Forms!fHighRisk!ScenarioID.Value
Else
sID = 1
End If
Me.lblScenarioID.Caption = "Scenario " & sID
If CurrentProject.AllForms("fHighRisk").IsLoaded = True Then
If Screen.ActiveControl.Name = "btnRAMimpact" Then
Me.btnForFocus.TabIndex = 0
ElseIf Screen.ActiveControl.Name = "btnRAMlhood" Then
Me.Tabordertest.TabIndex = 0
End If
End If
clr1 = RGB(122, 197, 205)
clr2 = RGB(152, 245, 255)
'button colors
Dim lblName As String, btnName As String, lblCaption As String, Rating As
Integer, ctrl As Control
For Each ctrl In Me.Controls
If ctrl.ControlType = acCommandButton Then
ctrlName = ctrl.Name
Me.Controls(ctrlName).BackColor = clr2
End If
Next
'Darkens buttons if value is stored in table
For i = 1 To 5
lblName = "Vardisp" & i
lblCaption = Me.Controls(lblName).Caption
If IsNull(DLookup("[Variable Impact]", "tImpact", "scenarioID = " & sID &
" AND [Impact Variable] = """ & lblCaption & """ ")) Then
GoTo Skip_loop2
Else
Rating = DLookup("[Variable Impact]", "tImpact", "scenarioID = " &
sID & " AND [Impact Variable] = """ & lblCaption & """ ")
End If
For b = 1 To 10
If Rating = b Then
btnName = "Var" & i & "R" & b
Me.Controls(btnName).BackColor = clr1
End If
Next
Skip_loop2:
Next
End Sub
I'm pretty lost on what's causing this, so any help is greatly appreciated. Everything I've been able to find relating to it is caused by the parent forms recordset not having any records, and since that's not the case here, I'm struggling to find a direction to head with it.
Thanks!
I'm developing a macro in Macro Express Pro that uses VBScript to scrub an HTML table to gather data. The data I'm gathering is in the FLN column. I want to build a list that the user can select from using the FLN, then they can gather the rest of the details within the row to use in other applications. The list looks like this:
My issue is that the list is only showing seven line items. The table I'm using for this example has eight lines. What is happening is I'm looping through to create this list, but when I get done copying the last FLN and go to the next row in the table (highlighted in yellow), I get an object required error.
I need to be able to read this line so that I can capture all rows in the table, then exit the loop when I reach the highlighted line. Unfortunately, the creators of the site with the table never named the table. There is a div that has an ID to it (div id="pnlBtn"). I've tried finding this ID, and receive an object error.
I am currently trying to find the last row in the table, but this is giving me an object error. I know the objIE.document part of my code is working as I was able to produce the list above. This was done by setting the counter I in the Do Until...Loop to 8, which only produces seven lines. If I set I to 9, I get an object error.
Here's the code I'm working with:
tdNode = 50
FLNDCC = objIE.Document.GetElementsByTagName("table")(0).GetElementsByTagName("td")(tdNode).GetElementsByClassName("txt_input1")(0).Value
I = 1
List = ""
intExitCount = 1
Do Until I = 8
If FLNDCC = NewFLNDCC Then
Exit Do
End If
If NewFLNDCC <> "" Then
FLNDCC = NewFLNDCC
End If
FLNDCC = I & ". " & FLNDCC
List = List & FLNDCC & vbCrLf
FLNDCC = Replace(FLNDCC, I & ". ", "")
TestRow = objIE.document.getElementsByTagName("tr")
For j = 0 To TestRow.length
MsgBox j
Next
I = I + 1
NewFLNDCC = objIE.Document.GetElementsByTagName("table")(0).GetElementsByTagName("td")(tdNode).GetElementsByClassName("txt_input1")(0).Value
If IsEmpty(NewFLNDCC) = True Then
Exit Do
End If
intExitCount = intExitCount + 1
If intExitCount = 10 Then
MsgBox "Do loop in VERIFY_HOV subroutine stuck in a loop." & vbCrLf & "Please submit an issue request with this message.", 48, "Stuck in Do Loop"
SetEverythingToNothing
End If
Loop
If I > 1 Then
Opt = InputBox("Please select the FLNDCC you want to work with:" & vbNewLine & List & vbNewLine, "Select an FLNDCC")
If IsEmpty(Opt) = True Then
Wscript.Echo "EXIT"
SetEverythingToNothing
End If
Opt = Opt - 1
tdNode = 50 + (Opt * 21)
Else
tdNode = 50
End If
FLNDCC = objIE.Document.GetElementsByTagName("table")(0).GetElementsByTagName("td")(tdNode).GetElementsByClassName("txt_input1")(0).Value
Is there a foolproof way to find the last row of a table that doesn't produce an object error?
I've found a solution. I didn't need to find the last row (highlighted in yellow), I just needed to avoid the error. The line that was creating the error was:
NewFLNDCC = objIE.Document.GetElementsByTagName("table")(0).GetElementsByTagName("td")(tdNode).GetElementsByClassName("txt_input1")(0).Value
On my ninth run through the loop, I was unable to find the txt_input1 value because it wasn't there. This gave me an object error. Here's how I solved it:
On Error Resume Next
NewFLNDCC = objIE.Document.GetElementsByTagName("table")(0).GetElementsByTagName("td")(tdNode).GetElementsByClassName("txt_input1")(0).Value
On Error goto 0
Now, I can have I set to 100 and, even though there are only 8 visible lines, it will kick out once txt_input1 is no longer available and print the list with all 8 lines.
In my app, users are selecting records from a listbox that they want to edit. Before they're able to edit, however, there is an additional query to make sure that info they want to change is correct. Below is the flow:
User inputs an Item_Number and clicks a button to query the DB for all Location(s) that contain that Item_Number. These populate into a listbox.
User selects the location(s) from the listbox that he/she wishes to edit
User inputs a new Last_Cost and/or new Vendor_ID for the selected items and clicks to confirm edit
In VBA, there is a query against another DB to ensure the new Vendor_ID is valid
The flow continues
The issue is that when the VBA code for the requery
DoCmd.Requery (VendorNumbers)
executes, it deselects all of the selected locations in the listbox. I've been able to narrow the issue down to this exact section of the VBA code.
I'm wondering if there is a way to ensure that the selected records stay selected, or if there is a way to store which rows were selected so they can be referenced again after the requery code is ran?
Entirety of the code. It may look slightly confusing because I don't have anything noted with "Me."
Private Sub EditInLocationsButton_Click()
EditVendorIDFixed = Null
EditVendorIDFixed = " " & EditVendorIDInput
DoCmd.Requery (VendorNumbers)
If EditVendorIDFixed = " " Or DCount("*", "VendorNumbers") > 0 Then
EditResponse = MsgBox("Are you sure you want to edit the selected items?", vbYesNo, "Edit Selected Items?")
If EditResponse = vbYes Then
'EditItemNumberResultsList.RowSource = ""
Dim i As Integer
For i = 0 To EditItemNumberResultsList.ListCount - 1
If EditItemNumberResultsList.Selected(i) Then
LastCost = EditItemNumberResultsList.Column(4, i)
EditID = EditItemNumberResultsList.Column(5, i)
VendorID = EditItemNumberResultsList.Column(6, i)
'MsgBox for verification purposes
MsgBox (LastCost & "-" & EditID & "-" & VendorID)
If EditLastCostInput = Null Then
LastCostforEditQuery = LastCost
Else
LastCostforEditQuery = EditLastCostInput
End If
If EditVendorIDInput = Null Then
VendorIDforEditQuery = VendorID
Else
VendorIDforEditQuery = EditVendorIDFixed
End If
End If
txtEditID = EditID
With DoCmd
.SetWarnings False
.OpenQuery "EditIminvlocRecords"
.SetWarnings True
End With
Next i
MsgBox ("The selected plants have been updated.")
End If
Else
MsgBox ("Error: The requested Vendor ID does not exist.")
End If
End Sub
Below is the VendorNumbers query:
SELECT dbo_apvenfil_sql.vend_no
FROM dbo_apvenfil_sql
WHERE (((dbo_apvenfil_sql.vend_no)=[Forms]![EditItemsInExistingPlants]![EditVendorIDFixed]))
ORDER BY dbo_apvenfil_sql.vend_no;
Again, this is just to verify that the Vendor_ID they input is valid, i.e. there are existing rows.
I think that this may be the best option because I don't know if you will ever be able to stop the requery from causing a refresh. I would be lying to say that I tested out this SQL but this is the basic idea for how I would perform what you are looking for. Instead of requerying VendorNumbers you just basically make it and run it right in VBA. This is also assuming that EditItemsInExistingPlants is the form from where you are running this code, if not then just adjust appropriately.
Private Sub EditInLocationsButton_Click()
EditVendorIDFixed = Null
EditVendorIDFixed = " " & EditVendorIDInput
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim strSQLQuery As String
strSQLQuery = "SELECT dbo_apvenfil_sql.vend_no " & _
"FROM dbo_apvenfil_sql " & _
"WHERE (((dbo_apvenfil_sql.vend_no)= " & Me.EditVendorIDFixed & ")) " & _
"ORDER BY dbo_apvenfil_sql.vend_no"
Set db = CurrentDb
Set rs = db.OpenRecordset(strSQLQuery, dbOpenDynaset)
If EditVendorIDFixed = " " Or rs.Count > 0 Then
EditResponse = MsgBox("Are you sure you want to edit the selected items?", vbYesNo, "Edit Selected Items?")
If EditResponse = vbYes Then
'EditItemNumberResultsList.RowSource = ""
Dim i As Integer
For i = 0 To EditItemNumberResultsList.ListCount - 1
If EditItemNumberResultsList.Selected(i) Then
LastCost = EditItemNumberResultsList.Column(4, i)
EditID = EditItemNumberResultsList.Column(5, i)
VendorID = EditItemNumberResultsList.Column(6, i)
'MsgBox for verification purposes
MsgBox (LastCost & "-" & EditID & "-" & VendorID)
If EditLastCostInput = Null Then
LastCostforEditQuery = LastCost
Else
LastCostforEditQuery = EditLastCostInput
End If
If EditVendorIDInput = Null Then
VendorIDforEditQuery = VendorID
Else
VendorIDforEditQuery = EditVendorIDFixed
End If
End If
txtEditID = EditID
With DoCmd
.SetWarnings False
.OpenQuery "EditIminvlocRecords"
.SetWarnings True
End With
Next i
MsgBox ("The selected plants have been updated.")
End If
Else
MsgBox ("Error: The requested Vendor ID does not exist.")
End If
End Sub
Can anyone suggest me a VBscript function to get the last 3 lines of a text document (for eg: log.txt ? Below is my code which can fetch and display the entire log on my screen but I want to get only last 3 lines of the log file named log.txt.
<script type="text/Vbscript">
Option Explicit
Dim File
File = "C:\\test.txt"
'***********************************************************
Sub LoadMyFile()
myDiv.innerHTML = LoadFile(File)
End Sub
'***********************************************************
Function LoadFile(File)
On Error Resume Next
Dim fso,F,ReadMe,Tab,i,paragraphe
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile(File,1)
LoadFile = Err.Number
If Err.Number <> 0 Then
MsgBox Err.Description,16," Error"
Exit Function
End If
ReadMe = F.ReadAll
Tab = split(ReadMe,vbcrlf)
For i = lbound(Tab) to ubound(Tab)
paragraphe=paragraphe & Tab(i) & "<br>"
Next
LoadFile = paragraphe
End Function
</script>
Code not working#Steve
<html>
<script type="text/Vbscript">
Option Explicit
Dim File
File = "C:\\test.txt"
'***********************************************************
Sub LoadMyFile()
myDiv.innerHTML = LoadFile(File)
End Sub
************************************************************
Function CheckProcesses()
dim startLine
On Error Resume Next
Dim fso,F,ReadMe,Tab,i,paragraphe
Set fso = CreateObject("Scripting.FileSystemObject")
Set F = fso.OpenTextFile(File,1)
LoadFile = Err.Number
If Err.Number <> 0 Then
MsgBox Err.Description,16," Error"
Exit Function
End If
ReadMe = F.ReadAll
Tab = split(ReadMe,vbcrlf)
For i = lbound(Tab) to ubound(Tab)
paragraphe=paragraphe & Tab(i) & "<br>"
Next
if ubound(Tab) > 2 Then
startLine = ubound(Tab) - 2
else
startLine = 0
end if
For i = startLine to ubound(Tab)
paragraphe=paragraphe & Tab(i) & "<br>"
Next
LoadFile = paragraphe
End Function
</script>
<input type="button" name="Log" id="Start" value="Log Dctm" onclick="CheckProcesses()"></html>
Thanks and regards
Deb
Another solution that avoids memory exhaustion with large files:
filename = "C:\path\to\your.txt"
numlines = 3
Set fso = CreateObject("Scripting.FileSystemObject")
'create and initialize ring buffer
ReDim buf(numlines-1)
For n = 0 To UBound(buf)
buf(n) = Null
Next
i = 0
'read lines into ring buffer
Set f = fso.OpenTextFile(filename)
Do Until f.AtEndOfStream
buf(i) = f.ReadLine
i = (i+1) Mod numlines
Loop
f.Close
'output ringbuffer content (skip null values)
For n = 1 To numlines
If Not IsNull(buf(i)) Then WScript.Echo buf(i)
i = (i+1) Mod numlines
Next
The array buf in combination with the index variable i and the modulo operation serves as a ring buffer containing the last lines read from the file (numlines at most).
At the end of the second loop (the one reading the input file), the index i points towards the array field after the one containing the last line read from the file, i.e. the beginning of the buffer.
The Null values from the array initialization let the output routine "slide" to the first content line (or the end of the buffer) if less than numlines lines were read from the file. The variable n in the output loop is just a counter so that the numlines elements from the ring buffer are read starting at index i and ending at index i-1 (modulo wrapping).
Given an array of lines (Tab), the last n lines to display start from UBound(Tab) - n + 1 and end with UBound(Tab). You should test for 'less than n lines in Tab' and for 'is last line of Tab empty (trailing EOL)'.
I am not able to test this, but If you know the UBound of the variable Tab, then the last three lines are UBound(tab)-2, UBound(tab)-1 and UBound(tab).
For i = ubound(Tab) - 2 to ubound(Tab)
paragraphe=paragraphe & Tab(i) & "<br>"
Next
Of course this requires that you have at least 3 lines in your log file, so, perhaps a little check should be done before entering the loop
dim startLine
if ubound(Tab) > 2 Then
startLine = ubound(Tab) - 2
else
startLine = 0
end if
For i = startLine to ubound(Tab)
paragraphe=paragraphe & Tab(i) & "<br>"
Next
Another solution
You can use this function :
Function ExtractLinesFromTextFile(ByRef TextFile, ByRef FromLine, ByRef ToLine)
Option Explicit
Dim Title,FromLine,ToLine,fso,Readfile,strBuff,InputFile,TotalNbLines
Title = "Extract Lines From TextFile © Hackoo 2014"
InputFile = "c:\test.txt"
Set fso = CreateObject("Scripting.FileSystemObject")
Set Readfile = Fso.OpenTextFile(InputFile,1)
strBuff = Readfile.ReadAll
TotalNbLines = Readfile.Line
Readfile.Close
MsgBox "The total number of lines in this file """& InputFile &""" = "& TotalNbLines,VbInformation,Title
'To extract the 3 last lines
MsgBox ExtractLinesFromTextFile(InputFile,TotalNbLines - 2,TotalNbLines),64,Title
'*********************************************************************************************************
Public Function ExtractLinesFromTextFile(ByRef TextFile, ByRef FromLine, ByRef ToLine) '<-- Inclusive
Const TristateUseDefault = -2 'To Open the file using the system default.
On Error Resume Next
If FromLine <= ToLine Then
With CreateObject("Scripting.FileSystemObject").OpenTextFile(TextFile,1,true,TristateUseDefault)
If Err.number <> 0 Then
MsgBox err.description,16,err.description
Exit Function
Else
Do Until .Line = FromLine Or .AtEndOfStream
.SkipLine
Loop
Do Until .Line > ToLine Or .AtEndOfStream
ExtractLinesFromTextFile = ExtractLinesFromTextFile & (.ReadLine & vbNewLine)
Loop
End If
End With
Else
MsgBox "Error to Read Line in TextFile", vbCritical,"Error to Read Line in TextFile"
End If
End Function
'*********************************************************************************************************