I have an odbc connection named "Parcel Picks by Hour" that is on an auto run timer every 15 minutes. I want to run an script that sends an email with the updated data after the refresh event is complete. all codes I have found were unsuccessful. since the timer is already built into the ODBC i dont want a code that refreshes the connection then sends an email i just want the refresh to trigger the code to run.
NOT AN ANSWER AN IDEA
Create a class like so, ive called mine clsCustomConnection
Private WithEvents cn As ADODB.Connection
Public Sub Initialise(cnADO As ADODB.Connection)
Set cn = cnADO
End Sub
Private Sub cn_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, _
adStatus As ADODB.EventStatusEnum, ByVal pCommand As ADODB.Command, _
ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
' Email function
MyEmailFunction ("VBAEventExample.co.uk")
End Sub
Then in a normal module, something like so
Public CustomADOConnection As clsCustomConnection
Sub setupADOconnection()
Dim ADOConn1 As New ADODB.Connection
' Set up connection
ADOConn1.ConnectionString = ""
ADOConn1.CursorLocation = adUseClient
' Sink to custom connection
Set CustomADOConnection = New clsCustomConnection
CustomADOConnection.Initialise ADOConn1
End Sub
Related
Suppose I have two hyperlinks (on excel sheet) referring to two documents:
e.g ( A.doc and B.doc ) on my local intranet.
I will open the first document "A.doc" then I will open the second one "B.doc"
The problem:
If there is already an opened word document and then I clicked hyperlink (Word Document on my local intranet),
The later file is not opened automatically and I have to click on the flashing taskbar button to open the cited second file.
This issue occurs only with Microsoft word documents found on my local intranet.
If there is no open document and I clicked on any word hyperlink, It opens normally without any issue.
Please watch this short video to understand my problem.
I need to utilize FollowHyperlink event in excel or any other method to:
bring the previous opened window A.doc to front and then bring the second one B.doc to front.
you may find it a strange question! But I have to do it manually each time to show and bring the second one to front.
I have used this API code (in a Word document) on Normal-ThisDocument:
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long
Dim LHwnd As Long
Private Sub Document_Open()
If Application.Documents.Count > 1 Then
LHwnd = FindWindow("rctrl_renwnd32", Application.ActiveWindow.Caption)
SetForegroundWindow (LHwnd)
End If
End Sub
And used that code on my excel sheet itself:
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
On Error Resume Next
Dim objWd As Object
Set objWd = GetObject(, "Word.Application")
AppActivate objWd.ActiveWindow.Caption
Set objWd = Nothing
End Sub
Finally, I found this helpful page Bring an external application window to the foreground But I could not adapted it to my need.
Please, try the next BeforeDoubleClick event. If the problem is related only to hyperlinks, it should work...
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Target.column = 1 And Target.Value <> "" Then 'limit this behavior to the first column
If LCase(left(Target.Value, 5)) = "http:" Then
Cancel = True
Dim objWd As Object, d As Object, arrD: arrD = Split(Target.Value, ".")
If LCase(left(arrD(UBound(arrD)), 3)) <> "doc" Then Exit Sub
On Error Resume Next
Set objWd = GetObject(, "Word.Application") 'find the Word open session, if any
On Error GoTo 0
If objWd Is Nothing Then
Set objWd = CreateObject("Word.Application")
End If
With objWd
.Visible = True
Set d = .Documents.Open(Target.Value)
End With
'force somehow the new open document window expose its handler...
Dim i As Long
Do Until objWd.ActiveWindow.Caption = d.name Or _
objWd.ActiveWindow.Caption = left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
i = i + 1: Debug.Print objWd.ActiveWindow.Caption, left(d.name, InstRev(d.name, ".")-1) & " [Read-Only] [Compatibility Mode]"
DoEvents: If i >= 10 Then Exit Do 'just in case, if something unexpected happens...
Loop
SetForegroundWindow CLngPtr(objWd.ActiveWindow.hWnd)
End If
End If
End Sub
It should work in 64 bit, but it is easy to be adapted for both cases, supposing that it works as you need.
I have to pull data from SAP. This error happens randomly:
Method 'Text' of object 'ISapCTextField' failed
I searched but none of the solutions work. Error handling by trying multiple times also didn't work. Instead of trying more methods, I avoided the .Text method altogether.
Example of line causing the error:
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
To avoid using the .text method, I used SendKeys to achieve the same thing. Basically making the SAP window as active window and selecting the desired field in SAP GUI by using set focus, and then using Ctrl+V via sendkeys to paste the text from a range to the field. Below is the code:
'Declaration
Declare Function FindWindow Lib "user32" Alias "FindWindowA" ( _
ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Declare Function SetForegroundWindow Lib "user32" ( _
ByVal HWnd As Long) As Long
'Finds SAP Window.
Public Sub ActivateSAPWindow()
Dim HWnd As Long
'SAP window Name can be found on the status bar of the Portal.
'Note: This only works in when you click on R/3 and it open a portal. It will not work if it open in the internet explorer
'To make it work for internet explorer , Simply change the name of the Window to find internet explorer or any window you wish.
HWnd = FindWindow(vbNullString, "R/3 - SAP NetWeaver Portal - Internet Explorer")
If HWnd Then
SetForegroundWindow HWnd
End If
End Sub
Public Sub SAPSafeText(ID As String, OriginCell As String)
'Location of the cell you wanna copy to the field.
Worksheets("SAP Mapping").Range(OriginCell).Copy
Call ActivateSAPWindow
Session.FindByID(ID).SetFocus
SendKeys "^v"
'Important to wait for completion before next line.
Wait (5)
End Sub
To call the function , Simply use SAP script record to get the Field ID name and parse into the SAPSafeText("ID of the Field as string", "Cell Range as string").
Example of call:
Call SAPSafeText("wnd[0]/usr/ctxtBWART-LOW", Low)
Call SAPSafeText("wnd[0]/usr/ctxtBWART-HIGH", High)
This is the brute force way but it works.
Why is the error happening?
Is there a better way to handle this?
I met the same situation too. I solve it. I think that is you use the sentence like
session.findbyid (*****).text = cells(i,j)
you should try to use
session.findbyid (*****).text = cells(i,j).value
You could try the following instead of sendkeys method:
...
Application.Wait (Now + TimeValue("0:00:01"))
session.findById("wnd[0]/usr/ctxtMATNR-LOW").text = "500000000"
...
Regards,
ScriptMan
below are snips of the code that could cause the random error. There are about 7 other Reports. Here is the MRP report example.
Public SapGuiAuto As Object
Public SAPApp As SAPFEWSELib.GuiApplication
Public SAPConnection As SAPFEWSELib.GuiConnection
Public Session As SAPFEWSELib.GuiSession
Sub InitSession()
On Error GoTo InternetAutomation
ErrorCounter = ErrorCounter + 1
Set SapGuiAuto = GetObject("SAPGUI")
If Not IsObject(SapGuiAuto) Then
Exit Sub
End If
Set SAPApp = SapGuiAuto.GetScriptingEngine()
If Not IsObject(SAPApp) Then
Exit Sub
End If
Set SAPConnection = SAPApp.Connections(0)
If Not IsObject(SAPConnection) Then
Exit Sub
End If
Set Session = SAPConnection.Sessions(0)
If Not IsObject(Session) Then
Exit Sub
End If
Exit Sub
InternetAutomation:
.........
End sub
sub MRP()
Call InitSession
Call TCodeBox("/n/DS1/APO_C_")
Call PlantCode_MRP("A11")
Call Material_MRP("E3")
Call SetPath_MRP
Call Execute
Call MRPReportProcess
End Sub
Sub PlantCode_MRP(Cell As String)
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub Material_MRP(Cell As String)
Worksheets("MB52 Total").Activate
session.findById("wnd[0]/usr/btn%_S_MATNR_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Sub SetPath_MRP()
session.findById("wnd[0]/usr/ctxtP_PATH").Text = Desktop
session.findById("wnd[0]/usr/txtP_NAME").Text = MRPFileName
End Sub
Sub TCodeBox(TCode As String)
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
On Error GoTo TCodeErrorHandler
session.findById("wnd[0]").sendVKey 0
TCodeErrorHandler:
session.findById("wnd[0]/tbar[0]/btn[15]").press
session.findById("wnd[0]/tbar[0]/okcd").Text = TCode
session.findById("wnd[0]").sendVKey 0
Resume Next
Exit Sub 'Enter
End Sub
Sub Execute()
session.findById("wnd[0]/tbar[1]/btn[8]").press
End Sub
Regards,Jacob.
Sometimes I could solve similar errors by restarting the transaction.
for example:
Sub PlantCode_MRP(Cell As String)
on error resume next
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
if err.number <> 0 then
Call TCodeBox("/n/DS1/APO_C_")
session.findById("wnd[0]/usr/ctxtS_WERKS-LOW").Text = Range(Cell)
end if
on error goto 0
'On Error GoTo InternetAutomation
session.findById("wnd[0]/usr/btn%_S_WERKS_%_APP_%-VALU_PUSH").press
Call SAPMultiSelect(Cell)
End Sub
Regards,
ScriptMan
We all know that ms access is not multitreaded so when msacces runs a long query it hangs waiting to the query to be completed. what i want is open from access an new instance of access to run a query or run vba code in background. after running it needs to kit itself after it turns back the results (maybe though the sql server background)
i have seen something before in excel but i wonder if it is posible to do in access
the excel variant is here [excel swarm][1
UPDate
i open access with the folowing code
Dim appAccess As Object
Set appAccess = CreateObject("Access.Application")
Call appAccess.OpenCurrentDatabase( _ "D:\test.accdb")
appAccess.UserControl = True
Set appAccess = Nothing
the target access db is preformatted with a loop as test with is started when access opens. the problem is that the souce access hangs during starting ans running of the target access.
i can use the timer to give it a delayed start and then its working.
the main problem is how can i stat a not preformated access db, create things like vba code, querys odbc connections etc and run it without the source db being hanging.
you could try something like this from a shell command to another VBA host, say excel, which could trigger the event. This is a class, where the properties of DB path and Query name are passed in, then GO is executed, it uses the Execute Complete event of the DBs ADO connection, I've coded it to create an Excel instance and populate with the results.
Ive not tested this fully as in the middle of something, but i'll test fully at lunch and edit as req'd, but a starting point
Option Explicit
Private WithEvents c As ADODB.Connection
Private strDBPath As String
Private strQueryToRun As String
Public Property Let DBPath(strPath As String)
strDBPath = strPath
End Property
Public Property Let QueryToRun(strQuery As String)
strQueryToRun = strQuery
End Property
Public Function GO()
Dim a As New Access.Application
a.OpenCurrentDatabase strDBPath, False
Set c = a.CurrentProject.Connection
c.EXECUTE strQueryToRun
a.CloseCurrentDatabase
a.Quit
Set a = Nothing
End Function
Private Sub c_ExecuteComplete(ByVal RecordsAffected As Long, ByVal pError As ADODB.Error, adStatus As ADODB.EventStatusEnum, _
ByVal pCommand As ADODB.Command, ByVal pRecordset As ADODB.Recordset, ByVal pConnection As ADODB.Connection)
' what to do with the results?
Dim xl As New Excel.Application
Dim xlWb As Excel.Workbook
xl.Visible = True
Set xlWb = xl.Workbooks.Add
xlWb.Sheets(1).Range("a1").CopyFromRecordset pRecordset
End Sub
Yes, that is possible.
Use command Shell to open another instance of Access - and add command line parameters Access to hold info about which queries to run.
today i tried to do a copy of a database(design and documents) by doing right click on database-> New copy... and i see that the new copy of database have smallest dimension of the source database (source database 900mb and the new copy 170mb).
I see also that if i access in the new copy of this database the size passes form 170mb to 400mb (i think is because notes create index...)
But i need to copy database only to create a backup so the size is important because i have to do daily backup and to consulted it only in particoular case.
So i built an agent to do this copy but the result is not the same, the new copy have the same dimension of the source database.
Is there a trick to obtain the same "compression" of right click on database-> New copy... but with script code ?
I post the code that i use but without that compression:
Dim Db As NotesDatabase
Dim Ws As New NotesUIWorkspace
Dim Session As New NotesSession
Dim DbDir As NotesDbDirectory
Dim AllDocs As NotesView
Dim SourceDb As NotesDatabase
Dim ArchiveDb As NotesDatabase
Dim SourceDoc As NotesDocument
Set Db=Session.CurrentDatabase
Set DbDir=Session.GetDbDirectory(Db.Server)
Set SourceDb = DbDir.GetFirstDatabase(DATABASE)
Do While Not SourceDb Is Nothing
Print"BackUp Database "+Cstr(SourceDb.FileName)
Gosub BackUpDatabase
Set SourceDb = DbDir.GetNextDatabase
Loop
Exit Sub
BackUpDatabase:
If SourceDb.IsOpen=False Then Call SourceDb.Open( "", "" )
Set ArchiveDb = SourceDb.CreateCopy( "", "C:\Test\"+Cstr(Day(Date))+"-"+Cstr(Month(Date))+"-"+Cstr(Year(Date))+"\"+SourceDb.FilePath)
Set AllDocs = SourceDb.CreateView( "#AllDocs", "SELECT #All" )
Set SourceDoc=AllDocs.GetFirstDocument
Do While Not SourceDoc Is Nothing
Call SourceDoc.CopyToDatabase(ArchiveDb)
Set SourceDoc=AllDocs.GetNextDocument(SourceDoc)
Loop
Call AllDocs.Remove()
Return
The "compression" as you call it is simply the "absence" of view- indices.
The database size consists of:
Size of all documents
Size of the design of the database
Empty Space (if data was deleted, but the database not compacted)
View indices
A new copy (via client) has NO indices, but as soon as you open a view, the size of the database will increase.
Your script is NOT a good idea for a backup:
All documents get a new Creation Stamp
All documents get a new replica id - Response- hierarchies will be completely lost after your copy
etc.
If you really want to go that direction, then you woould have to compact the database using a compact -D to get the free space and the view indices back,
but I would never do a backup of a production database like this...
Another (better) possibility would be to create a new replica with LotusScript- code and make a backup of that:
Set ArchiveDb = SourceDb.CreateReplica( "", "C:\Test\"+Cstr(Day(Date))+"-"+Cstr(Month(Date))+"-"+Cstr(Year(Date))+"\"+SourceDb.FilePath)
If you keep that database after doing the backup, then you might want to change the replica- id of the database using this code:
Option Public
Option Declare
Const wAPIModule = "NNOTES" ' Windows/32
Type API_TIMEDATE
lngInnards(1) As Long
End Type
Type API_DBREPLICAINFO
ID As API_TIMEDATE 'ID that is same for all replica files
intFlags As Integer 'Replication flags
intCutoffInterval As Integer 'Automatic Replication Cutoff
Cutoff As API_TIMEDATE 'Replication cutoff date
End Type
Declare Private Function NSFDbOpen Lib wAPIModule Alias "NSFDbOpen" _
( ByVal P As String, hDB As Long) As Integer
Declare Private Function NSFDbClose Lib wAPIModule Alias "NSFDbClose" _
( ByVal hDB As Long) As Integer
Declare Private Function NSFDbReplicaInfoGet Lib wAPIModule Alias "NSFDbReplicaInfoGet" _
(ByVal hdb As Long, hdbr As API_DBREPLICAINFO) As Integer
Declare Private Function NSFDbReplicaInfoSet Lib wAPIModule Alias "NSFDbReplicaInfoSet" _
(ByVal hdb As Long, hdbr As API_DBREPLICAINFO) As Integer
Sub ChangeReplicaID( strServer As String, strFilePath As String, strReplicaID As String )
Dim intRc As Integer
Dim lngDb As Long
Dim RepInfo As API_DBREPLICAINFO
If strServer = "" Then
intRc = NSFDbOpen( strFilePath, lngDb )
Else
intRc = NSFDbOpen( strServer & "!!" & strFilePath, lngDb )
End If
If intRc <> 0 Then
MessageBox "Could not open DB"
Exit Sub
End If
intRc = NSFDbReplicaInfoGet(lngDb, RepInfo)
If intRc <> 0 Then
MessageBox "Could not get replication info"
Exit Sub
End If
RepInfo.ID.lngInnards(1) = Val( "&H"+Left$( strReplicaID, 8 ) )
RepInfo.ID.lngInnards(0) = Val( "&H"+Right$( strReplicaID, 8 ) )
intRc = NSFDbReplicaInfoSet( lngDb, RepInfo) ' take a deep breath... :-)
intRc = NSFDbReplicaInfoGet( lngDb, RepInfo)
If intRc <> 0 Then
MessageBox "Could not get replication info after setting"
Else
MessageBox "Success"
End If
End Sub
But the best advice I can give: Use a professional Backup- Software to do that job.
Closed. This question needs details or clarity. It is not currently accepting answers.
Want to improve this question? Add details and clarify the problem by editing this post.
Closed 3 years ago.
Improve this question
i have Motorola Handheld MC55A with windows embedded handheld 6.5 and i want to start develop an app to read barcode .I didn't find any reference to do my command
i have installed VS2008 and start to create Smart Device Application with a simple form
Merit who deserve merit: Initially I didn't write the following code, I'm not sure who initially did it, may be was written by symbol developers...I'm not sure, I only have used it.
1- First at all download and install the Motorola EMDK, after that, you will copy the C:\Program Files (x86)\Motorola EMDK for .NET\v2.5\SDK\Smart Devices\Symbol.Barcode.dll file to \My Device\Windows folder in your pocket.
Public Class frmTest
Dim MyReader As Symbol.Barcode.Reader = Nothing
Dim MyReaderData As Symbol.Barcode.ReaderData = Nothing
Dim MyEventHandler As System.EventHandler = Nothing
Dim MyHandlerCB As System.EventHandler = Nothing
Private Sub frmTest_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles MyBase.Load
InitReader()
End Sub
Protected Overloads Overrides Sub OnClosing(ByVal e As System.ComponentModel.CancelEventArgs)
StopRead()
Me.TermReader()
MyBase.OnClosing(e)
End Sub
Private Function InitReader() As Boolean
' If reader is already present then fail initialize
If Not (Me.MyReader Is Nothing) Then
Return False
End If
'Create new reader, first available reader will be used.
Me.MyReader = New Symbol.Barcode.Reader
'Create reader data
Me.MyReaderData = New Symbol.Barcode.ReaderData( _
Symbol.Barcode.ReaderDataTypes.Text, _
Symbol.Barcode.ReaderDataLengths.DefaultText)
' create event handler delegate
Me.MyEventHandler = New System.EventHandler(AddressOf MyReader_ReadNotify)
'Enable reader, with wait cursor
Me.MyReader.Actions.Enable()
Return True
End Function
Private Sub TermReader()
'If we have a reader
If Not (Me.MyReader Is Nothing) Then
'Disable reader, with wait cursor
Me.MyReader.Actions.Disable()
'free it up
Me.MyReader.Dispose()
' Indicate we no longer have one
Me.MyReader = Nothing
End If
' If we have a reader data
If Not (Me.MyReaderData Is Nothing) Then
'Free it up
Me.MyReaderData.Dispose()
'Indicate we no longer have one
Me.MyReaderData = Nothing
End If
End Sub
Private Sub StartRead()
'If we have both a reader and a reader data
If Not ((Me.MyReader Is Nothing) And (Me.MyReaderData Is Nothing)) Then
'Submit a read
AddHandler MyReader.ReadNotify, Me.MyEventHandler
Me.MyReader.Actions.Read(Me.MyReaderData)
End If
End Sub
Private Sub StopRead()
'If we have a reader
If Not (Me.MyReader Is Nothing) Then
'Flush (Cancel all pending reads)
RemoveHandler MyReader.ReadNotify, Me.MyEventHandler
Me.MyReader.Actions.Flush()
End If
End Sub
Private Sub MyReader_ReadNotify(ByVal o As Object, ByVal e As EventArgs)
Dim TheReaderData As Symbol.Barcode.ReaderData = Me.MyReader.GetNextReaderData()
'If it is a successful read (as opposed to a failed one)
If (TheReaderData.Result = Symbol.Results.SUCCESS) Then
'Handle the data from this read
Me.HandleData(TheReaderData)
'Start the next read
Me.StartRead()
End If
End Sub
Private Sub HandleData(ByVal TheReaderData As Symbol.Barcode.ReaderData)
txtBarCode.Text = TheReaderData.Text
End Sub
Private Sub txtBarCode_GotFocus(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtBarCode.GotFocus
StartRead()
End Sub
Private Sub txtBarCode_LostFocus(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles txtBarCode.LostFocus
StopRead()
End Sub
End Class
You want to scan barcodes and insert them into textboxes from your app?
Try to enable Data Wedge from Control Panel.