I Got StopWatch , And i want that the stopwatch start to count from 01:00:12,000
my code(not works):
Dim sp As New Stopwatch
Dim lb As New Label
Me.Controls.Add(lb)
lb.Text = ""
sp.Elapsed.Hours.Equals(1)
sp.Elapsed.Minutes.Equals(0)
sp.Elapsed.Seconds.Equals(12)
sp.Elapsed.Milliseconds.Equals(0)
sp.Start()
lb.Text = sp.Elapsed.Hours.ToString & ":" & sp.Elapsed.Minutes.ToString & ":" & sp.Elapsed.Seconds.ToString & "," & sp.Elapsed.Milliseconds.ToString
This is not possible.
There is no way to initialize the Stopwatch class to anything but 0.
Nothing is stopping you from adding 1 hour and 12 seconds to the result though.
lb.Text = (sp.Elapsed.Hours + 1).ToString & ":" & sp.Elapsed.Minutes.ToString _
& ":" & (sp.Elapsed.Seconds + 12).ToString & "," _
& sp.Elapsed.Milliseconds.ToString
The StopWatch doesn't work that way. What you need to do is record the start time in a different variable and then add the Stopwatch's elapsed time to the start time
Dim StartTime AS Date = Date.Now
...
Dim EndTime AS Date = StartTime.AddMilliseconds(StopWatch1.ElapsedMilliseconds)
Related
I ran into a problem with my code.
My MS Access Database needs to reset the series number field at the beginning of a new month or year.
However when testing the database it works well until i get to the 10th record and afterwards i receive a duplicate value warning.
I'm totally confused on where i went wrong.
Please help? Code is pasted below:
Private sub form_beforeinsert(Cancel as integer)
dim vlast as variant
dim invnext as integer
me.invyear = format(date,"yyyy") & format(date, "mm")
vlast = dmax("SeriesNumber", "invoice", "InvYear='" & Me.invyear.value & "'")
if isnull(vlast) then
invnext = 1
else
invnext = vlast + 1
end if
me.seriesnumber = invnext
me.invoicenumber = format(date, "yyyy") & "-" & Format(date, "mm") & "-" Me.SeriesNumber
End Sub
It is because you seem to store everything as text. So, convert to a number to retrieve the numerical maximum value:
vlast = DMax("Val([SeriesNumber])", "invoice", "InvYear='" & Me!invyear.Value & "'")
A report is called from VBA to receive returned records from an Access pass-through query. After the DoCmd completes the report's parameters are set in the report's appropriate label containers setting their .Caption property as required. Access fails intermittently during this process which leads me to believe that the report is not truly open to receive the parameters. Here's the VBA sub:
Private Sub Report_Open(Cancel As Integer)
Dim strFromDate As String
Dim strToDate As String
Dim strWC As String
Dim intShift As Integer
Dim strSQL As String
strFromDate = InputBox("Enter From Date and Time: ")
strToDate = InputBox("Enter To Date and Time: ")
strWC = InputBox("Enter Work Center: ")
intShift = InputBox("Enter Shift: ")
strSQL = "exec dbo.uspWorkCentreReport_TEST " & "'" & strFromDate & "', " & "'" & strToDate & "', " & "'" & strWC & "', " & intShift & ";"
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQL
DoCmd.OpenReport "rpt_qry_ptq_uspWorkCentreReport", acViewReport
Me.lblFromDate.Caption = strFromDate
Me.lblToDate.Caption = strToDate
Me.lblWC.Caption = strWC
Me.lblShift.Caption = intShift
End Sub
When the failure occurrs VBA highlights the Me.lblFromDate.Caption = strFromDate. If I press Reset in VBA or End on the Run-time error '2467': dialog, Access abends without any other outward signs. Access then re-opens to save the copied *_Backupx.accdb and opens with a fresh copy of the .accdb. The error seems to be a standars MS error:
As I said the report is intermittent and when it fails VB always highlights the same line in code. How do I capture what is happening or can I make VB wait a half of full second before it tries to write the parameters?
As I remember, captions can not be modified, when report open. Only in design mode. So this is not correct, because you have already opened report
Me.lblFromDate.Caption = strFromDate
You should use text boxes instead of captions. Also you can clear the borders, fillings and so on, that text box will appear like a caption.
Finally the correct set of code was produced. The button click creates strOpenArgs and passes it with .OpenReport. The report opens and splits the OpenArgs and populates the appropriate labels with updated Captions. Text boxes would not work! Here's the button click event:
Private Sub btnPreviewP1_Click()
If (Me.txtToDateP1 < Me.txtFromDateP1) Then
MsgBox ("The From Date must occurr before the To Date!")
End If
Dim strFromDateHMS As String
Dim strToDateHMS As String
Dim strSQLP1 As String
Dim strOpenArgs As String
strFromDateHMS = Format(Me.txtFromDateP1, "yyyy-mm-dd") & " " & Me.cboFromHourP1 & ":" & Me.cboFromMinuteP1 & ":" & Me.cboFromSecondP1
strToDateHMS = Format(Me.txtToDateP1, "yyyy-mm-dd") & " " & Me.cboToHourP1 & ":" & Me.cboToMinuteP1 & ":" & Me.cboToSecondP1
strSQLP1 = "exec dbo.uspWorkCentreReport '" & strFromDateHMS & "','" & strToDateHMS & "','" & strWCP1 & "'," & strShiftP1
strOpenArgs = Me.RecordSource & "|" & strFromDateHMS & "|" & strToDateHMS & "|" & strWCP1 & "|" & strShiftP1
' This line is all that's needed to modify the PT query
CurrentDb.QueryDefs("ptq_uspWorkCentreReport").SQL = strSQLP1
DoCmd.OpenReport "rpt_ptq_uspWorkCentreReport", acViewReport, , , , strOpenArgs
End Sub
And here's the reports _Open:
Private Sub Report_Open(Cancel As Integer)
Dim SplitOpenArgs() As String
SplitOpenArgs = Split(Me.OpenArgs, "|")
Me.lblFromDate.Caption = SplitOpenArgs(1)
Me.lblToDate.Caption = SplitOpenArgs(2)
Me.lblWC.Caption = SplitOpenArgs(3)
Me.lblShift.Caption = SplitOpenArgs(4)
End Sub
This opens the report every time with new appropriate data, so long as the report is closed before the form's button is pressed again for another refresh of the report. If the report is not closed the report stays up with the original data and does not refresh with new data... But that is another question I am about to ask. Thanks All.
I'm frustrated that I can't figure this out. Have tried few different types of loops to display a Multiplication table. All I get it one line in the label. What am I doing wrong?
Private Sub btnDisplay_Click(sender As Object, e As EventArgs) Handles btnDisplay.Click
Dim intNum As Integer
Dim intCount As Integer
Dim intAnswer As Integer
Dim myString As String
Integer.TryParse(txtNumber.Text, intCount)
intNum = 0
Do While intNum < 12
intNum = intNum + 1
intAnswer = intNum * intCount
lblTable.Text = " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString()
Loop
From the looks of it, every time the code loops it sets the label text to the current result, while overwriting the previous result.
If you want the label to display multiple lines of data, you can try something like this:
lblTable.Text &= " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString() & Environment.NewLine
The "Environment.NewLine" at the end will add the newline between each result.
The "&" before the "=" is used to append to the end of the existing text. This is simlar to doing:
lblTable.Text = lblTable.Text & "..." & Environment.NewLine
Also, just a side note. If you want multiple lines in a label, you may need to set the AutoSize property to false and configure the desired size of the label properly.
On this line:
lblTable.Text = " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString()
it is only storing the last result.
You will need to pre-pend the existing results to the new results.
Label1.Text &= " " & intNum.ToString() & " * " & intCount.ToString() & " = " & intAnswer.ToString() & Environment.NewLine
I added a & before the = so that the new results will be appended to the end of the existing contents of Label1 and a NewLine on the end to make it a little neater
Firstly, you are assigning the result of your loop to the same label, so you will only have one label.
If you want to create multiple labels you should be creating them as you go:
Dim top_pos as integer = 30 ' first label's Top
Dim left_pos as integer = 30 ' first label's Left
For intNum = 1 to 12 ' Im assuming you want the table from 1 to 12
intAnswer = intNum * intCount
Dim lbl As New Label
With lbl
.text = Cstr(intNum) & " * " & Cstr(intCount) & " = " & Cstr(intAnswer)
.location = New Point(left_pos,top_pos) 'set its position
... 'and so on
Me.Controls.Add(lbl)
End With
top_pos = top_pos + 30 ' moves the position for the next label.
Next
I'm trying from Excel to scan a shared inbox for emails with attachments, which were received on a certain date. The aim is to save the attachments and import them into the workbook running the code.
Here's the code I have so far adapted from Download attachment from Outlook and Open in Excel to scan the inbox and print some info on the emails it finds
Sub extractEmailDetails()
Dim oOlAp As Object, oOlns As Object, oOlInb As Object, oOlInp As Object
Dim oOlItm As Object
Dim strDateFrom As String, strDateTo As String
Dim searchDate As Date
searchDate = #12/9/2015# 'mm/dd/yyyy
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
'~~> Get Outlook instance
Set oOlAp = GetObject(, "Outlook.application")
Set oOlns = oOlAp.GetNamespace("MAPI")
Set oOlInp = oOlns.Folders("SHR-Cust Ops MI Team Inbox")
Set oOlInb = oOlInp.Folders("Inbox")
'~~> Store the relevant info in the variables
For Each oOlItm In oOlInb.Items.Restrict("[attachment] = True AND [receivedTime] > " & strDateFrom & " AND [receivedTime] < " & strDateTo)
Debug.Print oOlItm.ReceivedTime & " " & oOlItm.Subject
Next
End Sub
When I search for the 8th of December it only brings back emails that were received after 8am.
I changed the settings for working hours in the calendar to midnight to midnight (no working hours) and the code then brought back all emails for the specified date. However, I can't leave my calendar with no working hours. Is there a way to change the default behaviour to ignore the working hours?
It sure sounds like your are getting GMT + your local time zone offset.
What is your TZ?
After messing around with this a little I've found a solution. A very obvious one. You can't just provide the date, you also need to provide a time, so:
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy") & "'"
Becomes
[...]
strDateFrom = "'" & Format(searchDate, "dd/mm/yyyy hh:mm") & "'"
strDateTo = "'" & Format(searchDate + 1, "dd/mm/yyyy hh:mm") & "'"
I changed the above to use string builder but some reason its not comming through on the loop its returning ok through the OrdersLine variable but not to the stream . Below is the loop im declaring it in
Dim OrdersLine As String
For Each item As String In split
For Each thisEntry As DataRow In orderHeaderInformation.Rows
orderLineInformation = connection.SqlSelectToDataTable(scriptBuilder.GetOrderLineInformation(item, thisEntry.Item("location")))
Dim orderNumber = From row In newEntries.AsEnumerable()
Select row.Field(Of String)("ordernumber") Distinct
For Each c In IO.Path.GetInvalidFileNameChars
filename = thisEntry.Item("orderNumber").ToString().Replace(c, "")
Next
ediExportPath = configuration.EditExport
filename = ediExportPath & "\" & filename & "_" & thisEntry.Item("location") & ".edi"
Dim streamWriter As New IO.StreamWriter(filename)
OrdersLine = ExportOrdersLine(orderLineInformation).ToString()
streamWriter.WriteLine(OrdersLine)
streamWriter.Close()
streamWriter.Dispose()
Next
Next
Public Function ExportOrdersLine(editProductLine As DataTable) As String
Dim retVal As String
Dim newRecord As infoEDILine
Dim filenameWithoutExtensions As String
Dim i As Integer = 1
Dim edilIneOrder As New StringBuilder
For Each thisentry In editProductLine.Rows
edilIneOrder.AppendLine("LIN+" & i & thisentry.Item("TagBcode") & ":EN'")
edilIneOrder.AppendLine("PIA+1" & thisentry.Item("PLU") & ":SA'")
edilIneOrder.AppendLine("IMD+C++CU'")
edilIneOrder.AppendLine("IMD+F++:::" & thisentry.Item("Style.Description") & "'")
edilIneOrder.AppendLine("QTY+" & thisentry.Item("PLU") & ":1'")
edilIneOrder.AppendLine("QTY+" & thisentry.Item("OnOrder") & ":1'")
edilIneOrder.AppendLine("TAX+7+VAT+++:::00" & thisentry.item("VatRate") & "'")
' if the vat rate is zero add three zeros to above line
' if the vat rate is not zero add only two 00 lke above line
' if no decimal places add one decimal place of zero
edilIneOrder.AppendLine("MOA+203:" & thisentry.item("LineNetCost") & "'")
edilIneOrder.AppendLine("PRI++AAA:" & thisentry.Item("GrossCost") & "'")
edilIneOrder.AppendLine("PRI++AAB:" & thisentry.Item("WholeSaleCost") & "'")
edilIneOrder.AppendLine("UNS+S'")
i = i + 1
Next
Return edilIneOrder.ToString()
End Function
Turns Out I was missing
streamWriter.AutoFlush = True