I'm a new user, so please go gentle on me.
I have created an Outlook rule that runs the below script which writes some of the email message properties to an SQL table.
The connection is working fine, when I run this as a macro on a selected message, it works fine... but when I leave it to run as a rule, it just keeps writing the currently selected email...
I can't figure out where I'm going wrong...
Code is below :
Sub TEST_TO_SQL(Item As MailItem)
Dim sSubject As String
Dim sTo As String
Dim sFrom As String
Dim sMsgeID As String
Dim sRcvd As Date
Set Item = Application.ActiveExplorer.Selection.Item(1)
sSubject = Item.Subject
sTo = Item.ReceivedByName
sFrom = Item.SenderEmailAddress
sMsgID = Item.EntryID
sRcvd = Item.ReceivedTime
Const adOpenStatic = 3
Const adLockOptimistic = 3
Set objConnection = CreateObject("ADODB.Connection")
Set objRecordSet = CreateObject("ADODB.Recordset")
objConnection.Open _
"Provider=SQLOLEDB;" & _
"Data Source=SQLSERVER\SQLEXPRESS;" & _
"Trusted_Connection=Yes;" & _
"InitialCatalog=SQLDB;" & _
"User ID=sa;Password=password;"
objRecordSet.Open _
"INSERT INTO [SQLDB].[dbo].[EMAIL_Log] (LogCompanyID, LogSubject, LogStartDate, LogEndDate, LogShortDesc, LogLongDesc, LogFrom, LogTo, LogMessageID, LogCategory1)" & _
"VALUES ('11'," & "'" & sSubject & "'" & ", " & "'" & Format(sRcvd, "yyyy-mm-dd hh:mm:ss", vbUseSystemDayOfWeek, vbUseSystem) & "'" & ", '', 'short desc', 'Long Desc', " & "'" & sFrom & "'" & ", " & "'" & sTo & "'" & ", " & "'" & sMsgID & "'" & ", '47')", objConnection, adOpenStatic, adLockOptimistic
End Sub
You're always using the currently selected mail item. Remove the line:
Set Item = Application.ActiveExplorer.Selection.Item(1)
Then Item will be the one passed in to the Sub
Related
I found this code on your site VBscript to get the properties of event from event ID and modified it to pars a different section of the security event log message however I don't get any results.
Set wmi = GetObject("winmgmts://./root/cimv2")
Set re = New RegExp
re.Pattern = "New Logon:\s+" & _
"Security ID:\s*(.*?)\s+" & _
"Account Name:\s*(.*?)\s+" & _
"Account Domain:\s*(.*?)\s+" & _
"Logon ID:\s*(.*?)\s+" & _
"Logon GUID:\s*(\d+)"
qry = "SELECT * FROM Win32_NTLogEvent WHERE EventCode=4624"
For Each evt In wmi.ExecQuery(qry)
For Each m In re.Execute(evt.Message)
Security_ID = m.SubMatches(0)
Account_Name = m.SubMatches(1)
Account_Domain = m.SubMatches(2)
Logon_ID = m.SubMatches(3)
Logon_GUID = m.SubMatches(4)
WScript.Echo "Yes"
Next
WScript.Echo "New Logon" & Account_Name & " " & Account_Domain & " " & Logon_ID
WScript.Echo " "
Next
What am I doing wrong?
Important:
reformulated Pattern property (Logon GUID);
Cosmetic:
option explicit and ON ERROR GOTO 0 as a matter of general principle;
where clause in the wmi query extended merely to reasonably limit output range;
more extensive echo for debugging purposes;
mm instead of m variable: I hate one-letter names...
The script:
option explicit
ON ERROR GOTO 0
Dim re, qry, evt, mm, wmi
Set re = New RegExp
re.Pattern = "New Logon:\s+" _
& "Security ID:\s*(.*?)\s+" _
& "Account Name:\s*(.*?)\s+" _
& "Account Domain:\s*(.*?)\s+" _
& "Logon ID:\s*(.*?)\s+" _
& "Logon GUID:\s*({.*?})"
' re.IgnoreCase = True ' Set case insensitivity.
' re.Global = True ' Set global applicability.
qry = "SELECT * FROM Win32_NTLogEvent WHERE logfile='security'" _
& " and EventCode=4624 " _
& " and (RecordNumber = 36413 or RecordNumber = 44911)"
Dim Security_ID, Account_Name, Account_Domain, Logon_ID, Logon_GUID
Set wmi = GetObject("winmgmts://./root/cimv2")
For Each evt In wmi.ExecQuery(qry)
For Each mm In re.Execute(evt.Message)
Security_ID = mm.SubMatches(0)
Account_Name = mm.SubMatches(1)
Account_Domain= mm.SubMatches(2)
Logon_ID = mm.SubMatches(3)
Logon_GUID = mm.SubMatches(4)
WScript.Echo "Yes " & evt.TimeGenerated
Next
WScript.Echo "New Logon " & Account_Name & "," & Account_Domain & "," & Logon_ID
WScript.Echo "Logon_GUID " & Logon_GUID
Next
Output (administrator command prompt console):
==>cscript.exe D:\VB_scripts\SO\30291316.vbs
Yes 20150517203428.318232-000
New Logon ANONYMOUS LOGON,NT AUTHORITY,0x3C70F59
Logon_GUID {00000000-0000-0000-0000-000000000000}
Yes 20150518073715.217688-000
New Logon SYSTEM,NT AUTHORITY,0x3E7
Logon_GUID {00000000-0000-0000-0000-000000000000}
==>
I have two recordset which want to update one of them by value of the other. I did like this
stSql = "SELECT dbo.tblCableProperty.CatalogCode FROM dbo.tblCable INNER JOIN " & _
" dbo.tblCableProperty ON dbo.tblCable.CablePcode = dbo.tblCableProperty.CablePcode" & _
" WHERE dbo.tblCable.prjsubcode=" & prjsubcode & " AND dbo.tblCable.Active=1 " & " And dbo.tblCable.Gtag='" & Gtag & "' And dbo.tblCable.TagNo=" & tagno & " And dbo.tblCable.NTag=" & NTag & " And dbo.tblCable.EndStr='" & EndStr & "'"
rs.Open stSql, cn, adOpenStatic, adLockOptimistic
catalogCode = rs!catalogCode
rs.Close
stSql = "SELECT *,'' as ShowNum FROM viwShowNum WHERE prjsubcode=" & prjsubcode & " AND Active=1 " & " And Gtag='" & Gtag & "' And TagNo=" & tagno & " And NTag=" & NTag & " And EndStr='" & EndStr & "' ORDER BY 8"
rs.Open stSql, cn, adOpenDynamic, adLockOptimistic
rs.MoveFirst
stSql = "Select * from tblCoreCode where CatalogCode=" & catalogCode
Set rsCoreCode = New ADODB.Recordset
rsCoreCode.CursorLocation = adUseClient
rsCoreCode.Open stSql, cn, adOpenStatic, adLockOptimistic
While Not rs.EOF
criteria = "RealNum='" & rs!CoreNo & "'"
rsCoreCode.Filter = criteria
rs!ShowNum = CStr(rsCoreCode!ShowNum)
rsCoreCode.Filter = adFilterNone
rs.MoveNext
Wend
I get the following error on this part
rs!ShowNum = CStr(rsCoreCode!ShowNum)
multiple-step operation generated errors. check each status value
rsCoreCode!ShowNum is varchar(5). I tried to set the value
rs!ShowNum = "1"
but again I got the same error.
where is the problem?
Thank you
As asked in my comment, if rs.Updatable or rs!ShowNum.DataUpdatable are false, you can use this piece of code from Microsoft to retrieve an updatable RecordSet.
Same issue occurred to me the problem was that i violated an object property , in my case it was size the error came out as
"IntegrationException: Problem (Multiple-step operation generated errors. Check each status value.)"
Imports ADODB
Dim _RecordSet As Recordset
_rs.Fields.Append("Field_Name", DataTypeEnum.adVarChar, 50)
_Recordset("Field_Name").Value = _RecordDetails.Field_NameValue
_RecordDetails.Field_NameValue length was more than 50 chars , so this property was violated , hence the error occurred , so you should probably check if you didn't match one of the properties
i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right record(would be one ID for each record in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below. The weird thing here is that if i double click it again it will refresh and open the right record without opening anymore windows..
How can i fix that? I dont want to do it twice :)
Public Sub sendMRBmail(mrbid)
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr (34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
Found the problem. Changed instruction below, adding acFormEdit to it and it worked:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit
i am creating a .vbs file that should open access, and inside access a form call "Issue Details", but passing a parameter, meaning that if i have 10 issues in my "Issues" table a vbs file is created for each one and when clicked should open the right form id(would be one ID for each in the table). It is so far opening access and it is opening the form(Issue Details) but it is blank. What am i missing? Help, getting crazy here ... Check code below
Public Sub sendMRBmail(mrbid)
Dim tmprs As DAO.Recordset
Dim db As DAO.Database
Set db = CurrentDb
Set tmprs = db.OpenRecordset("select * from Issues where [ID] = " & mrbid)
If IsNull(tmprs) Then
MsgBox "Record is not yet available"
Else
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid
End If
Set tmprs = Nothing
End Sub
Private Sub Create_Click()
On Error GoTo Err_Command48_Click
Dim snid As Integer
snid = Me.ID
Dim filename As String
filename = "S:\Quality Control\vbs\QC" & snid & ".vbs"
Dim proc As String
proc = Chr(34) & "sendMRBmail" & Chr(34)
Dim strList As String
strList = "On Error Resume Next" & vbNewLine
strList = strList & "dim accessApp" & vbNewLine
strList = strList & "set accessApp = createObject(" & Chr(34) & "Access.Application" & Chr(34)")" & vbNewLine
strList = strList & "accessApp.OpenCurrentDataBase(" & Chr(34) & "S:\Quality Control\Quality DB\Quality Database.accdb" & Chr(34) & ")" & vbNewLine
strList = strList & "accessApp.Run " & proc & "," & Chr(34) & snid & Chr(34) & vbNewLine
strList = strList & "set accessApp = nothing" & vbNewLine
Open filename For Output As #1
Print #1, strList
Close #1
Err_Command48_Click:
If Err.Number <> 0 Then
MsgBox "Email Error #: " & Err.Number & ", " & "Description: " & Err.Description
Exit Sub
End If
End Sub
I already found the answer. I added acFormEdit at the end of my DoCmd and it worked, check below:
DoCmd.OpenForm "Issue Details", , , "[ID] = " & mrbid, acFormEdit
In my vb6 I am getting error 3704 operation is not allowed when object is closed.
I have search stackoverflow for similar problem but I think I'm missing something. I need to update every row in vfp based from recordset rs1 Here my code:
Option Explicit
Dim cn As New ADODB.Connection
Dim cn1 As New ADODB.Connection
Private Sub trns_Click()
Set cn = New ADODB.Connection
Set cn1 = New ADODB.Connection
cn.ConnectionString = MDI1.txtcn.Text
cn.Open
cn1.ConnectionString = "Provider=VFPOLEDB;Data Source=\\host1\software\MIL\company0"
cn1.Open
rs1.Open "Select * from trans", cn, adOpenStatic, adLockPessimistic
Do While Not rs2.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs2.EOF Then
rs2.MoveNext
End If
Loop
rs2.close
Update query doesn't return recordset, hence your rs2 is not opened.
You perform your loop on the wrong recordeset : I replaced the some of the rs2 with rs1 in your code.
Do While Not rs1.EOF
rs2.Open "update transac set no_ot_1_5 = " & rs1.Fields("ovt1") & ", no_ot_2_0 = " & rs1.Fields("ovt2") & ", no_ot_3_0" _
& "= " & rs1.Fields("ovt3") & ",Meal_allw = " & rs1.Fields("meal_allow") & ",on_duty = " & rs1.Fields("cnt") & ",no_d_local = " & rs1.Fields("local") & ",no_d_sick" _
& "= " & rs1.Fields("sick") & ",no_d_abs = " & rs1.Fields("absence") & ",no_d_spc = " & rs1.Fields("special") & ",Revenue02" _
& "= " & rs1.Fields("refund") & ",Revenue05 = " & rs1.Fields("prepay") & ",Deduct05 = " & rs1.Fields("prepay") & ",Revenue01 = " & rs1.Fields("comm") & "where code = '" & rs1.Fields("emp_code") & "' and transac.date = CTOD('" & trans.txtend2 & "')", cn1, adOpenDynamic, adLockPessimistic
If Not rs1.EOF Then
rs1.MoveNext
End If
Loop
rs1.close
You dont need to create a recordset to execute an update, insert or delete on the database. Just use the statement cn1.Execute YourSqlStatement where YourSqlStatement is the string you are passing on the rs2.Open instruction. The Execute method on the connection optionally accepts a byRef variable where you can get the number of records affected.
Example:
Dim nRecords As Integer
cn1.Execute "Update Table Set Field = Value Where AnotherField = SomeValue ", nRecords
MsgBox "Total Updated Records: " & Format(nRecords,"0")
try to open your rs2 before using if in the do while statement., or do it like this
rs2.open " blah blah blah "
Do Until rs2.eof
For Each fld In rs2.field
value_holder = fld.value
Next
rs2.movenext
Loop