I have a question about using StreamWriter in visual basic 2008
, Below is code for database filtering using visual basic 2008
On Error Resume Next
If e.KeyCode = Keys.Enter Then
'' Me.Table1BindingSource.Filter = "EmpID = ' " & Me.txtsearch.Text & "'"
On Error Resume Next
Dim temp As Integer = 0
Me.Table1BindingSource.Filter = "EmpID = ' " & Me.txtsearch.Text & "'"
For i As Integer = 0 To Table1DataGridView.RowCount - 1
For j As Integer = 0 To Table1DataGridView.ColumnCount - 1
If Table1DataGridView.Rows(i).Cells(j).Value.ToString = txtsearch.Text Then
''if item found then we play sound ok
My.Computer.Audio.Play("F:\beep.wav", AudioPlayMode.WaitToComplete)
My.Computer.Audio.Play("F:\beep.wav", AudioPlayMode.WaitToComplete)
temp = 1
''write the user name that logged in
Dim file As System.IO.StreamWriter
file = My.Computer.FileSystem.OpenTextFileWriter("C:\Users\haydeer\Desktop\test.txt", True)
file.WriteLine(txtsearch.Text)
file.Close()
txtsearch.Text = ""
End If
Next
Next
'' trytime += 1 'Increment if not found
If temp = 0 And trytime <= 2 Then 'Check if not found 3 times (or more)
''if item not found then we play sound err
My.Computer.Audio.Play("F:\computer_access.wav", AudioPlayMode.WaitToComplete)
Me.Table1TableAdapter.Fill(Me.MydbDataSet.Table1)
Me.Table1DataGridView.Refresh()
trytime += 1 'Increment if not found
txtsearch.Text = ""
ElseIf temp = 0 And trytime >= 3 Then
'' Alarm Gose on
MsgBox("three time")
End If
End If
my problem is when the user is logged-in it will write the date of login for that user, iam successful store the user , but i want to store the date too for example (00:00:00 AM)? any idea ?
To turn the current time on the machine to a string:
My.Computer.Clock.LocalTime.ToLongTimeString (1:23:45 AM)
My.Computer.Clock.LocalTime.ToShortTimeString (1:23 AM)
My.Computer.Clock.LocalTime.ToLongDateString (Saturday, January 1, 2000)
My.Computer.Clock.LocalTime.ToShortDateString (1/1/2000)
My.Computer.Clock.LocalTime.ToString (1/1/2000 1:23:45 AM) I suggest this one
-Mg
Related
I'm running a script that extracts from SAP a number of N archives(based on a input file that contains the name of each file). The scripts reads the data for each file from a input txt file and writes the status after each run to an Excel file.
After each run the file is generated but before being saved it gives this
error.
Windows cannot find 'filename.zip'. Make sure you typed the name correctly and then try again
I have disabled the Read Only option of the folder where I'm saving the report, I've run sfc /scannow in case I have any corrupted files in my system and I have also checked the Path variables in case any were missing but to no avail.
Here is the code
If Not IsObject(application) Then
Set SapGuiAuto = GetObject("SAPGUI")
Set application = SapGuiAuto.GetScriptingEngine
End If
If Not IsObject(connection) Then
Set connection = application.Children(0)
End If
If Not IsObject(session) Then
Set session = connection.Children(0)
End If
If IsObject(WScript) Then
WScript.ConnectObject session, "on"
WScript.ConnectObject application, "on"
End If
Set filesysobj = CreateObject("Scripting.FileSystemObject")
Set list = CreateObject("Scripting.Dictionary")
Set file = filesysobj.OpenTextFile("fullpath\to\input\file\.txt", 1)
' wb - workbook(the file), ws-worksheet(the first sheet of the excel file)
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Open("fullpath\to\excel\output\file")
objExcel.Visible = False
Set sheet = objWorkbook.sheets("Sheet1")
' Reading from the input file
nr = 0
Do until file.AtEndOfStream
request = file.ReadLine
list.Add nr, request
nr = nr + 1
Loop
file.Close
' Indexes for the lines and rows in the excel file
i = 2 ' Second Row
j = 5
For Each line in list.Items
On Error Resume Next
session.findById("wnd[0]").maximize
session.findById("wnd[0]/tbar[0]/okcd").text = "controlpanel\path"
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/tbar[1]/btn[2]").press
' line - name from file
session.findById("wnd[0]/usr/ctxtZQT1D-REQ").text = line
session.findById("wnd[0]/usr/ctxtZQT1D-REQ").caretPosition = 9
session.findById("wnd[0]").sendVKey 0
session.findById("wnd[0]/usr/tabsREQUEST_OBJECTS/tabpREQUEST_OBJECTS_FC6/ssubREQUEST_OBJECTS_SCA:/SYMSOFT/CP_ZQTMS010_NEW:0917/cntlCONTAINER/shellcont/shell").currentCellColumn = "DATE"
session.findById("wnd[0]/usr/tabsREQUEST_OBJECTS/tabpREQUEST_OBJECTS_FC6/ssubREQUEST_OBJECTS_SCA:/SYMSOFT/CP_ZQTMS010_NEW:0917/cntlCONTAINER/shellcont/shell").selectedRows = "0"
session.findById("wnd[0]/usr/tabsREQUEST_OBJECTS/tabpREQUEST_OBJECTS_FC6/ssubREQUEST_OBJECTS_SCA:/SYMSOFT/CP_ZQTMS010_NEW:0917/cntlCONTAINER/shellcont/shell").pressToolbarButton "ATT_DISP"
' define of the output path for the file & the filename
session.findById("wnd[1]/usr/ctxtDY_PATH").text = "fullpath\saving\folder"
session.findById("wnd[1]/usr/ctxtDY_FILENAME").text = line & ".zip"
session.findById("wnd[1]/usr/ctxtDY_PATH").setFocus
session.findById("wnd[1]/usr/ctxtDY_PATH").caretPosition = 26
session.findById("wnd[1]/tbar[0]/btn[0]").press
' -------Writing the errors
' End If
If Err.Number <> 0 Then
sheet.Cells(i, j).Value = "Error " & Err.Description
i = i + 1
Else
sheet.Cells(i, j - 1) = line
sheet.Cells(i, j) = "has been completed"
i = i + 1
End If
next
objExcel.ActiveWorkbook.Save
objExcel.Quit
The archives are saved correctly but without clicking OK on the error the script won't get past 1 iteration nor it will save the archive.
I don't know anyone that can read VBScript. I am wondering if anyone help me read the following statements?
Public Sub GetNodeName(CompIP)
Dim i
Dim ProcedureName
ProcedureName = "GetNodeName(CompIP): " & CompIP
ProcedureName = "ProcedureName & ": " & $Date & ": " & $Time
For i = To $CompName -> Size
If CompIP = $COMPUTER_IP[i] Then
$NodeNumber = i
$ComputerID = $CompName[i]
i = $CompName -> Size + 1
$DemoMode = 0
Else 'Demomode
$NodeNumber = 1
$DemoMode = 1
$ComputerID = "Demo Mode"
End If
Next
and
For i = 1 To $CompName -> Size
If $CompName[i] = NodeName Then
GetNodeNumber=i
'Exit Loop
i = $CompName -> Size + 1
End if
Next
If GetNodeName = -1 Then $Trace("Node not found")
ComputerName is TABLET4. IP Address is 172.10.10.7.
Whatever language that is, the intent of the code is clear.
The sub iterates through parallel arrays $CompName and $COMPUTER_IP two find the name of the computer ($CompName[i]) that corresponds to the provided id (CompIP).
If a match is found, it sets $NodeNumber to the index of the match, $ComputerID to the name of the computer, and $DemoMode to 0.
If no match is found, it sets $NodeNumber to 1, $ComputerID to Demo Mode, and $DemoMode to 1.
To get around a runtime error I need to read from an SAP table AGR_1251 in chunks using VBScript when I run a (SE16 | AGR_1251) query. I get this error TSV_TNEW_PAGE_ALLOC_FAILED - No more storage space available for extending an internal table.
As a work around, we manually copy 750 roles from the user by roles at a time, add a "*" to those that end with a certain character, then paste this back into the multiple select dialog to get the the AGR_1251 extract results in chunks.
I can't figure out how to do this in vbscript. How do I programmatically chunk this data? Ideally I would deduplicate it as well, but its not required.
The code has to run on both vbscript and in javascript, so I can't use excel or other windows tools like wscript. The best idea I have so far is to scroll through and copy just the roles to a file, read them back into an array and dedupe as I read them, then alter them, then loop back through the list to chuck out the results.
This is WAY above my nearly nonexistant vbscript skills. I can't be the only one who has had this problem. Can anyone point me to examples code that does this?
I'm open to suggestions on a better approach as well. I think my solution is fugly to say the least.
OK, this code is fugly with some unneeded variables, but it works.
Sub Save_AGR_1251s(Tcodes_array,Chunk_size)
Go_AGR_1251
writelog("Processing " & ubound(Tcodes_array) & " Tcodes in AGR_1251...")
k = 0
s = Chunk_size
max = ubound(Tcodes_array)
part = 0
roles_processed = 0
For i = 0 To max Step s
Go_AGR_1251
session.findById("wnd[0]/usr/txtMAX_SEL").text = ""
session.findById("wnd[0]/usr/txtMAX_SEL").setFocus
session.findById("wnd[0]/usr/txtMAX_SEL").caretPosition = 11
session.findById("wnd[0]/usr/btn%_I1_%_APP_%-VALU_PUSH").press
k = i + s
counter = 0
part = part + 1
If k > max Then k = max End If
For j = i To k-1
' writelog("Save_AGR_1251s Processing Tcode: " & Tcodes_array(j))
If (Tcodes_array(j) <> "STMS" or Tcodes_array(j) <> "SCC4") Then
'NOTE: The slow insert is used on XXXX Prod as a work around to odd UI behavior - change with caution - But SLOW!!
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,7]").setFocus
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,7]").text = Tcodes_array(j)
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,7]").caretPosition = 1
'VKey 13 = Shift-F1 (insert new row)
session.findById("wnd[1]").sendVKey 13
If Debug_flag = True Then
writelog("i=" & i & " j=" & j & " k=" & k & " s=" & s &" max=" & max &" counter= " & counter)
writelog("part =" & part & " roles= " & roles & "roles_processed="& roles_processed & " Tcodes_array= " & Tcodes_array(j))
End If ' Debug_flag
counter = counter + 1
roles_processed = roles_processed + 1
End If ' Tcodes_array
Next 'for j to k
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").setFocus
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1,1]").caretPosition = 13
session.findById("wnd[1]/tbar[0]/btn[8]").press
session.findById("wnd[0]").sendVKey 8
session.findById("wnd[0]").sendVKey 45
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").select
session.findById("wnd[1]/usr/subSUBSCREEN_STEPLOOP:SAPLSPO5:0150/sub:SAPLSPO5:0150/radSPOPLI-SELFLAG[1,0]").setFocus
session.findById("wnd[1]/tbar[0]/btn[0]").press
session.findById("wnd[1]/usr/ctxtDY_PATH").text = dir
file_name = AGR_1251_filename & "_Part_" & part & c_dash & postfix & Datafile_ext
session.findById("wnd[1]/usr/ctxtDY_FILENAME").text = file_name
writelog("Saving file: " & dir & file_name)
session.findById("wnd[1]/usr/ctxtDY_FILE_ENCODING").text = File_encoding
session.findById("wnd[1]/usr/ctxtDY_PATH").setFocus
session.findById("wnd[1]/usr/ctxtDY_PATH").caretPosition = 16
session.findById("wnd[1]").sendVKey 11
Go_Home
Next ' For i
End Sub
Note that you can do this much faster on most systems by simply doing this
for i = 1 to 100
session.findById("wnd[1]/usr/tabsTAB_STRIP/tabpSIVA/ssubSCREEN_HEADER:SAPLALDB:3010/tblSAPLALDBSINGLE/ctxtRSCSEL_255-SLOW_I[1," & 7 & "]").text = "Test " & i
next 'for i
Hy I am new to programming vbscript.I am trying to make a textbox for user in which user has to enter file version(format 1,0,0,0).user must type one integer within commas.but I failed to make a validation script to do so.. Can you please help me. Thanks in advance.I have been created this script to perform other kind of validation but I don't know how to do the validation for x,y,z,h format..
Do
dtm = InputBox("Please Enter a Numeric File version using commas", _
"File version")
Select Case True
Case isNull(dtm), (not isNumeric(dtm)), dtm = "", dtm = empty, (dtm < 1 OR dtm > 9)
MsgBox "Please enter between 1 and 9"
Case else
Exit do
End Select
Loop While True
'script on test pass
Something like this should do the job (have not tested with wscript/cscript), assuming accepted numbers are 0 to 9.
Function GetVersionNumber() As String
Dim iParts, sVersion, oTmp, dtm
iParts = 0
sVersion = ""
Do
dtm = InputBox("Please Enter a Numeric File version using commas", "File version")
For Each oTmp In Split(dtm, ",")
If IsNumeric(Trim(oTmp)) Then
If Len(sVersion) > 0 Then sVersion = sVersion & ","
sVersion = sVersion & Trim(oTmp)
iParts = iParts + 1
Else
MsgBox "Please enter between 0 and 9!" & vbCrLf & "You have typed " & oTmp
iParts = 0 ' Reset to zero accepted parts
sVersion = "" ' Reset to zero length string
End If
Next
Loop Until iParts = 4 ' x,y,z,h format <- 4 parts
GetVersionNumber = sVersion
End Function
I am reading a text file with 5000 strings. Each string contains Date+Time and then 3 values. The delimiter between Date and Time is a space, and then the three values are tab delimited. First string (strData(0)) is just a header, so I do not need that. Last string is just a simple "End".
The below code works, but it takes 1 minute to import into the worksheet! What can I do to improve this, and what is taking time?
Screen updating is off.
'open the file and read the contents
Open strPpName For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1
strData() = Split(MyData, vbCrLf)
'split the data and write into the correct columns
Row = 3
i = 0
For Each wrd In strData()
If i > 0 Then 'first string is only header
tmpData() = Split(wrd, vbTab)
DateString() = Split(tmpData(0), " ")
If DateString(0) <> "End" Then
ActiveSheet.Cells(Row, 5) = DateString(0) 'Date
ActiveSheet.Cells(Row, 6) = DateString(1) 'Time
ActiveSheet.Cells(Row, 2) = tmpData(1) 'Value1
ActiveSheet.Cells(Row, 3) = tmpData(2) 'Value2
ActiveSheet.Cells(Row, 4) = tmpData(3) 'Value3
Row = Row + 1
Else
GoTo Done
End If
End If
i = i + 1
Next wrd
Done:
Try with something like this:
Dim Values(), N, I
N = 100
ReDim Values(6, N)
...
Do While Not EOF(1)
I = I + 1
If I > N Then
N = N + 100
ReDim Preserve Values(6, N)
End If
Values(0, I) = ...
...
Loop
Range("A1:F" & i) = Values
The loop will work with arrays that in VBA are much faster than working with the sheet.
Excel can handle multiple types of delimiters (tab and space) with get data from text. This is what I have from macro recorder
Sub Macro1()
'
' Macro1 Macro
'
'
With ActiveSheet.QueryTables.Add(Connection:= _
"TEXT;C:\Users\jeanno\Documents\random.txt", Destination:=Range("$A$1"))
.CommandType = 0
.Name = "random_1"
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = True
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = True
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = 437
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = True
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = False
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
This will be much faster than string manipulation in VBA.
I think the problem is you might be reading the file in Binary. Try the following approach. I ran 5100+ records and it parsed it in under a second.
Public Sub ReadFileToExcel(filePath As String, rowNum As Long)
'******************************************************************************
' Opens a large TXT File, reads the data until EOF on the Source,
' adds the data in a EXCEL File, based on the row number.
' Arguments:
' ``````````
' 1. The Source File Path - "C:\Users\SO\FileName.Txt" (or) D:\Data.txt
' 2. The Row number you wish to start adding data.
'*******************************************************************************
Dim strIn As String, lineCtr As Long
Dim tmpData, DateString
'Open the SOURCE file for Read.
Open filePath For Input As #1
'Loop the SOURCE till the last line.
Do While Not EOF(1)
'Read one line at a time.
Line Input #1, strIn
lineCtr = lineCtr + 1
If lineCtr <> 1 Then
If InStr(strIn, "END") = 0 Then
tmpData = Split(strIn, vbTab)
DateString = Split(tmpData(0), " ")
ActiveSheet.Cells(rowNum, 5) = DateString(0) 'Date
ActiveSheet.Cells(rowNum, 6) = DateString(1) 'Time
ActiveSheet.Cells(rowNum, 2) = tmpData(1) 'Value1
ActiveSheet.Cells(rowNum, 3) = tmpData(2) 'Value2
ActiveSheet.Cells(rowNum, 4) = tmpData(3) 'Value3
rowNum = rowNum + 1
End If
End If
Loop
Debug.Print "Total number of records - " & lineCtr 'Print the last line
'Close the files.
Close #1
End Sub