Hi i have this code and it give me error:
Type of value has a mismatch with column typeCouldn't store <10/1/2012
3:43:30 PM> in time_in_am Column. Expected type is MySqlDateTime.
my mySQL data type for "time_in_am" is DateTime.
dataRow = dataSet.Tables(0).NewRow()
dataRow("time_in_am") = DateTime.Now
dataSet.Tables(0).Rows.Add(dataRow)
I believe MySQL's accepted DateTime format is yyyy-mm-dd hh:mm:ss
So, alter the 2nd row of your code to:
dataRow("time_in_am") = DateTime.Now.ToString("yyyy-MM-dd HH:mm:ss")
For what each of the format 'magic strings' mean, see here
If you find yourself using this often (which is probable) you can create an extension:
Imports System.Runtime.CompilerServices
Public Module MyExtensions
<Extension()>
Public Function ToMySql(d As Date) As String
Return d.ToString("yyyy-MM-dd HH:mm:ss")
End Function
End Module
Now you can use this in your code as follows:
dataRow("time_in_am") = DateTime.Now.ToMySql()
Return d.toString("yyyy-MM-dd HH:mm:ss")
will solve it.. :)
I think another shortest way to do it is using Format()
dataRow("time_in_am") = Format(DateTime.Now, "yyyy-MM-dd HH:mm:ss")
i was looking a way to convert this vb6 date conversion to mysql accepted value to vb.net;
'convert date to mysql format
Public Function convToYMD(strDate)
strYear = CStr(Year(strDate))
strmonth = CStr(Month(strDate))
strday = CStr(Day(strDate))
strhour = CStr(Hour(strDate))
strminute = CStr(Minute(strDate))
strsecond = CStr(Second(strDate))
If Len(strhour) = 1 Then
strhour = "0" & strhour
ElseIf Len(strhour) = 0 Then
strhour = "00"
End If
If Len(strminute) = 1 Then
strminute = "0" & strminute
ElseIf Len(strminute) = 0 Then
strminute = "00"
End If
If Len(strsecond) = 1 Then
strsecond = "0" & strsecond
ElseIf Len(strsecond) = 0 Then
strsecond = "00"
End If
If Len(strday) = 1 Then
strday = "0" + strday
ElseIf Len(strday) = 0 Then
strday = "00"
End If
If Len(strmonth) = 1 Then
strmonth = "0" & strmonth
ElseIf Len(strmonth) = 0 Then
strmonth = "00"
End If
convToYMD = strYear + "-" + strmonth + "-" + strday + " " + strhour + ":" + strminute + ":" + strsecond
end function
found this code and solves my problem!
i just added inside the module
If DateFormat.ShortDate Then
Return d.ToString("yyyy-MM-dd")
ElseIf DateFormat.LongDate Then
Return d.ToString("yyyy-MM-dd HH:mm:ss")
End If
many, many thanks!
Related
I want to convert the Persian dates of word file using macro. It is really difficult to convert each date using online converter.
I pasted the date in the code and against each date i pasted the converted date. But i know this is not the a good approach to solve this problem. I am trying to remove the match case to reduce the time and manual inputs.
findarray = Array("١٣٩۶/١٢/٢٩ ")
replarray = Array("20/march/2018") * this is sample date
For i = 0 To UBound(findarray)
Selection.Find.ClearFormatting
Selection.Find.Replacement.ClearFormatting
With Selection.Find
.Text = findarray(i)
.Replacement.Text = replarray(i)
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchCase = False
.MatchWholeWord = True
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
End With
Selection.Find.Execute Replace:=wdReplaceAll
Next i
All dates of the file replace at the same place with out effecting other values and text.
Trying & testing the code taken a hit as the single sample of Arabic date found to have a mix of two different sets of Unicode characters range ( i.e. 1632-1641 and 1776-1785). This is detected only after multiple attempts. However a broad working solution is reached and tested for few recent dates.
Edit: Code modified for Persian date conversion. it used Code used simple conversion method used in Link1.
Option Explicit
Sub testFindLoop()
Dim Rng As Range, Cnt As Long, NumStr As String, SearchPatterns(1 To 2) As String
Dim ArabicTxt As String, HijriTxt As String, GregTxt As String, GregDt As Date
Dim yStr As String, mStr As String, dStr As String
Dim i As Integer, SearchPattern As String
NumStr = "[" & ChrW(1632) & "-" & ChrW(1641) & ChrW(1776) & "-" & ChrW(1785) & "]"
SearchPatterns(1) = "(" & NumStr & "{4})/(" & NumStr & "{1,2})/(" & NumStr & "{1,2})"
SearchPatterns(2) = "([0-9]{1,2})/([0-9]{1,2})/([0-9]{4})"
Cnt = 0
For i = 1 To 2
Set Rng = ActiveDocument.Content
SearchPattern = SearchPatterns(i)
With Rng.Find
.Text = SearchPattern
.MatchWildcards = True
Do While .Execute
Cnt = Cnt + 1
ArabicTxt = Rng.Text
'Debug.Print Cnt & "-" & ArabicTxt
If i = 1 Then
yStr = Left(ArabicTxt, 4)
mStr = Replace(Mid(ArabicTxt, 6, 2), "/", "")
dStr = Replace(Right(ArabicTxt, 2), "/", "")
yStr = ArabicToEnglish(yStr)
mStr = ArabicToEnglish(mStr)
dStr = ArabicToEnglish(dStr)
Else
yStr = Right(ArabicTxt, 4)
dStr = Replace(Left(ArabicTxt, 2), "/", "")
mStr = Replace(Mid(ArabicTxt, IIf(Len(dStr) = 2, 4, 3), 2), "/", "")
End If
dStr = IIf(Len(dStr) = 1, "0" & dStr, dStr)
mStr = IIf(Len(mStr) = 1, "0" & mStr, mStr)
HijriTxt = yStr & "-" & mStr & "-" & dStr
'Debug.Print Cnt & "-" & ArabicTxt & "---->" & HijriTxt
GregDt = Greg_Date(HijriTxt)
'Debug.Print Cnt & "-" & ArabicTxt & " --> " & HijriTxt & " --> " & Format(GregDt, "dd-mmm-yyyy HH:MM:ss")
Rng.Text = Format(GregDt, "dd/mmm/yyyy")
Rng.Collapse wdCollapseEnd
Loop
End With
Next i
'ActiveDocument.SaveAs "C:\users\user\desktop\ArabicTest.Docx"
End Sub
Private Function ArabicToEnglish(sdate As String) As String
Dim i As Integer, AscwVal As Integer
ArabicToEnglish = ""
For i = 1 To Len(sdate)
AscwVal = AscW(Mid(sdate, i, 1))
If AscwVal >= 1632 And AscwVal <= 1641 Then
ArabicToEnglish = ArabicToEnglish & Chr(AscwVal - 1632 + 48)
Else
ArabicToEnglish = ArabicToEnglish & Chr(AscwVal - 1776 + 48)
End If
Next
End Function
Function Greg_Date(perDate) As Double
Const PERSIAN_EPOCH As Long = 1948321 ' The JDN of 1 Farvardin 1
Dim epbase As Long
Dim epyear As Long
Dim mdays As Long
Dim iYear As Integer
Dim iMonth As Integer
Dim iDay As Integer
iYear = Left(perDate, 4)
iMonth = Mid(perDate, 6, 2)
iDay = Right(perDate, 2)
If iYear >= 0 Then
epbase = iYear - 474
Else
epbase = iYear - 473
End If
epyear = 474 + (epbase Mod 2820)
If iMonth <= 7 Then
mdays = (CLng(iMonth) - 1) * 31
Else
mdays = (CLng(iMonth) - 1) * 30 + 6
End If
Greg_Date = CLng(iDay) _
+ mdays _
+ Fix(((epyear * 682) - 110) / 2816) _
+ (epyear - 1) * 365 _
+ Fix(epbase / 2820) * 1029983 _
+ (PERSIAN_EPOCH - 1)
Greg_Date = Greg_Date - 2415018.5
End Function
The yStr,mStr,dStr may be required to rearrange depending on date format used in the document.
I have code that parses out the last word on a string.
ie. Stack/Over/Flow will give me "Flow".
But I want to get "Over/Flow".
This is what I got, but only able to get "Flow"
arr(counter - 2) = "'" & mid(Text, InStrRev(Text, "/") + 1) & "'"
I would use Split()
Sub lastTwo()
Dim str As String
str = "Stack/Over/Flow"
Dim splt() As String
splt = Split(str, "/")
If UBound(splt) > 0 Then
Debug.Print splt(UBound(splt) - 1) & "/" & splt(UBound(splt))
End If
End Sub
Here is a function that does it:
Function lastParts(str As String, delim As String, x As Long) As String
Dim splt() As String
splt = Split(str, "/")
If UBound(splt) + 1 >= x Then
Dim t As String
t = "=INDEX(INDEX({""" & Join(splt, """;""") & """},N(IF({1},ROW(" & UBound(splt) - x + 2 & ":" & UBound(splt) + 1 & "))),),)"
lastParts = Join(Application.Transpose(Application.Evaluate(t)), delim)
Else
lastParts = str
End If
End Function
It has three parts, the string, the delimiter and the number of returns.
It can be called using your code:
arr(counter-2) = lastParts(Text,"/",2)
or from the worksheet
=lastParts(A1,"/",2)
Initially misread the question. You can nest InStrRev() calls
arr(counter - 2) = "'" & mid(Text, InStrRev(Text, "/",InStrRev(Text, "/")-1)+1) & "'"
I find it difficult to get the actual working hour and minute based on the Pay Amount and Pay rate per hour.
Example : working duration = (wages / pay per hour)
The following is my code. Please help.
strActDuration = CStr(Math.Round((dblActual / dblPayAmount), 1))
Dim parts As String() = strActDuration.Split("."c)
Dim strhour As Integer = 0
Dim strminutes As Integer = 0
If parts.Length = 1 Then
strhour = Integer.Parse(parts(0))
strminutes = 0
ElseIf parts.Length = 2 Then
strhour = Integer.Parse(parts(0))
strminutes = Integer.Parse(parts(1))
'strroundminutes = CInt(Math.Round(strminutes, 3))
'strroundminutes = CInt(Math.Truncate(strminutes / 10))
End If
strCombineDuration = strhour & "Hr " & strminutes & "Min"
Keep the duration as a number (double) and work in minutes; convert to Hours/Minutes using .NET formats:
dblMinutes = Math.Round(60*dblActual/dblPayAmount, 1)
Dim ts as TimeSpan = New Timespan(0, dblMinutes, 0)
strDuration = Format(ts.Hours, "0") & " Hr " & Format(ts.Minutes, "0")) & " Min"
I was debugging this code but I am not sure why this is returning false instead of true.
?Day(i)>salday(0)
False
?Day(i)
31
?salday(0)
20
?isnumeric(day(i))
True
?isnumeric(salday(0))
True
Option Explicit
Option Compare Text
Sub genOP()
Dim wO As Worksheet
Dim i As Long, j As Long
Dim stDate, enDate, intVal, entR As Long, salDay, salAmt, stTime, enTime, dbMin, dbMax
Dim stRow As Long
Dim cet, curMn
'On Error Resume Next
Application.ScreenUpdating = False
stDate = STG.Range("B2"): enDate = STG.Range("B4")
intVal = Split(STG.Range("B3"), ","): entR = STG.Range("B5")
salDay = Split(STG.Range("B6"), "-")
salAmt = STG.Range("B7"): stTime = STG.Range("B8"): enTime = STG.Range("B9"): dbMin = STG.Range("B10"): dbMax = STG.Range("B11")
Set wO = ThisWorkbook.Sheets.Add
TEMP.Cells.Copy wO.Range("A1")
stRow = 19
curMn = Month(stDate)
For i = CLng(stDate) To CLng(enDate)
If stRow > 19 Then
wO.Rows(stRow & ":" & stRow).Copy
wO.Rows(stRow + 1 & ":" & stRow + 1).Insert Shift:=xlDown
Application.CutCopyMode = False
End If
cet = Trim(DESC.Range("A" & WorksheetFunction.RandBetween(2, DESC.UsedRange.Rows.Count)))
If STG.Range("B14") = "ON" Then
cet = cet & "Transaction amount " & Chr(34) & "&TEXT(H" & stRow & "," & Chr(34) & "#,##0.00" & Chr(34) & ")&" & Chr(34) & " GEL,"
End If
If STG.Range("B13") = "ON" Then
cet = cet & Chr(34) & "&TEXT(B" & stRow & "-1," & Chr(34) & "dd mmm yyyy" & Chr(34) & ")&" & Chr(34)
End If
If STG.Range("B12") = "ON" Then
cet = cet & " " & Format(stTime + Rnd * (enTime - stTime), "HH:MM AM/PM")
End If
If curMn = Month(i) And (Day(i) >= salDay(0) And Day(i) <= salDay(1)) Then 'Salary Day
cet = Trim(DESC.Range("A" & WorksheetFunction.RandBetween(2, DESC.UsedRange.Rows.Count)))
wO.Range("B" & stRow) = Format(i, "DD-MM-YYYY")
wO.Range("I" & stRow) = salAmt
wO.Range("L" & stRow) = MonthName(Month(i)) & "- Salome Baazov - " & "Geo" & " Ltd "
curMn = WorksheetFunction.EDate(i, 1)
Else
wO.Range("B" & stRow) = Format(i, "DD-MM-YYYY")
wO.Range("H" & stRow) = WorksheetFunction.RandBetween(dbMin, dbMax) + (WorksheetFunction.RandBetween(0, 1) * 0.5)
wO.Range("L" & stRow) = "=" & Chr(34) & cet & Chr(34)
End If
stRow = stRow + 1
i = i + intVal(WorksheetFunction.RandBetween(LBound(intVal), UBound(intVal))) - 1
Next i
wO.Rows(stRow).EntireRow.Delete
wO.Range("I" & stRow).Formula = "=SUM(I19:I" & stRow - 1 & ")"
wO.Range("H" & stRow).Formula = "=SUM(H19:H" & stRow - 1 & ")"
wO.Activate
Application.ScreenUpdating = True
STG.Range("B5") = stRow - 1
MsgBox "Process Completed"
End Sub
Because you are comparing two Variants with different types (As it turned out after our discussions... thx #MatsMug). The comparison result is undefined behavior when comparing Variants of different types, one numeric and one String.
It's the Variant anomalies once again.. Consider this MCVE:
Sub Test1()
Dim i, salday
i = CDate("5/30/2017")
salday = Split("20-20-20", "-")
Debug.Print Day(i), salday(0) ' 30 20
Debug.Print Day(i) > salday(0) ' False
Debug.Print Day(i) > CStr(salday(0)) ' True
' ^^^^
Debug.Print Val(Day(i)) > salday(0) ' True
' ^^^^
End Sub
Although salday(0) is a String Variant, explicitly converting it to String with CStr solved the issue. However, without that conversion, the comparison failed. VBA did not implicitly convert the number to a string or vice-versa. It compared two Variants of different types and returned a rubbish result.
For more about the Variant curse, read For v=1 to v and For each v in v -- different behavior with different types
As it turns out, using CLng or Val to force number comparison is the safe way to go, or CStr to force text comparison.
Consider further these three simple examples:
Sub Test1()
Dim x, y: x = 30: y = "20"
Debug.Print x > y ' False !!
End Sub
Sub Test2()
Dim x As Long, y: x = 30: y = "20"
' ^^^^^^
Debug.Print x > y ' True
End Sub
Sub Test3()
Dim x, y As String: x = 30: y = "20"
' ^^^^^^
Debug.Print x > y ' True
End Sub
As you can see, when both variables, the number and the string, were declared variants, the comparison is rubbish. When at least one of them is explicit, the comparison succeeds!
Dim stDate, enDate
This instruction declares two Variant variables. They're assigned here:
stDate = STG.Range("B2"): enDate = STG.Range("B4")
Assuming [B2] and [B4] contain actual date values, at that point the variables contain a Variant/Date. That's because the implicit code here is as follows:
stDate = STG.Range("B2").Value: enDate = STG.Range("B4").Value
But you probably know that already. Moving on.
salDay = Split(STG.Range("B6"), "-")
salDay is also an implicit Variant. That instruction is quite loaded though. Here's the implicit code:
salDay = Split(CStr(STG.Range("B6").Value), "-")
This makes salDay an array of strings. So here we are:
?Day(i)
31
?salday(0)
20
The leading space in front of 31 is because the immediate pane always leaves a spot for a negative sign. salDay(0) being a String, there's no leading space. That was your clue right there.
?Day(i)>salday(0)
False
With salday(0) being a String, we're doing a string comparison here, as was already pointed out. Except there's no leading space in front of the 31; the implicit code is this, because the type of Day(i) is Integer:
?CStr(Day(i)) > salDay(0)
False
The solution is to get rid of salDay altogether: you don't need it. Assuming [B6] also contains an actual date, you can get the day into an Integer right away:
?Day(STG.Range("B6").Value)
As a bonus you decouple your code from the string representation of the underlying date value that's in your worksheet, so changing the NumberFormat won't break your code. Always treat dates as such!
I am new in Macro VBA and I am facing a problem.
I having two string to compare, and how do I get the string as Result shown if the similarity numbers found in both string?
string 1 : 1,2,3,4,6,7,8,9,10,11,12,13,19,20
string 2 : 2,3,7,8,9,10,11
After comparison:
Result : 2,3,7,8,9,10,11
Code:
If ActiveSheet.Cells(irow + 1, 12).Value = "" Then
'MsgBox "Data not found"
Else
temp = vbNullString
temp = ActiveSheet.Cells(irow + 1, 12).Value
'expanddata() use to expend a sequence of numbers into a display string as below
' 1,2-4,6 -> 1,2,3,4,6
temp = expanddata(temp)
If Worksheets("AI").Cells(irow + 1, 10).Value = temp Then
temp = ConvNum(temp) 'if whole string same then convert back to 1,2-4,6
Else
'the comparision make in here
End If
Worksheets("AI").Cells(irow + 1, 10) = temp
End If
Thank you.
Automating powershell to print the list to a text file c:\temp\test.txt
Sub Test()
a = "(1,2,3,4,6,7,8,9,10,11,12,13,19,20)"
b = "(2,3,7,8,9,10,11)"
cmd = Shell("powershell.exe """ & a & """ | Where {""" & b & """ -Contains $_} | out-file c:\temp\test.txt", 1)
End Sub
For irow = 1 To numofrow
ptcolno = 12
If ActiveSheet.Cells(irow + 1, 12).Value = "" Then
'MsgBox "Data not found"
Else
temp = vbNullString
temp = ActiveSheet.Cells(irow + 1, 12).Value
temp = expanddata(temp)
If Worksheets("AI").Cells(irow + 1, 10).Value = temp Then
temp = ConvNum(temp)
Else
' Answer
Temp2 = Worksheets("AI").Cells(irow + 1, 10).Value
arr1 = Split(Temp2, ",")
arr2 = Split(temp, ",")
temp = vbNullString
For i = LBound(arr2) To UBound(arr2)
For j = LBound(arr1) To UBound(arr1)
If arr2(i) = arr1(j) Then
temp = temp & "," & arr2(i)
End If
Next j
Next i
temp = Right(temp, Len(temp) - 1)
temp = ConvNum(temp)
' End
End If
Worksheets(checktype & "_BUYOFF_1").Cells(irow + 1, 68) = temp
Please try the below code.
Sub comparestring()
string1 = "1,2,3,4,6,7,8,9,10,11,12,13,19,20"
string2 = "2,3,7,8,9,10,11"
str1 = Split(string1, ",")
str2 = Split(string2, ",")
For i = 0 To UBound(str1)
For j = 0 To UBound(str2)
If str1(i) = str2(j) Then
If matchedcontent <> "" Then
matchedcontent = matchedcontent & "," & str1(i)
Else
matchedcontent = str1(i)
End If
End If
Next j
Next i
Range("A3").Value = matchedcontent
End Sub
Assign the two strings to string 1 and string 2 like below results will be printed at Cells A3
string1=Activesheet.Range("A1").Value
string2=Activesheet.Range("A2").Value
try this
Option Explicit
Function CompareStrings(string1 As String, string2 As String) As String
Dim s As Variant
For Each s In Split(string1, ",")
If "," & string2 & "," Like "*," & s & ",*" Then CompareStrings = CompareStrings & s & ","
Next s
CompareStrings = Left(CompareStrings, Len(CompareStrings) - 1)
End Function
which could be called as follows
Sub main()
Dim string1 As String, string2 As String, stringRes As String
string1 = "1,2,3,4,6,7,8,9,10,11,12,13,19,20"
string2 = "2,3,7,8,9,10,11"
stringRes = CompareStrings(string1, string2)
MsgBox stringRes
End Sub