Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Need help with Macro: Copy selection from one app insert to another ap

Status
Not open for further replies.

Groom84

Technical User
Feb 27, 2009
19
0
0
SE
Hi
I think this is an appropriate section to start this thread (VBA) that has to do with API:

I will put an application window that we all share called: "Map Network Drive" (see the pic). Found in My Computer, Tools, Map Network Drive...

1.
From this window, I would like to tab a specific amount of times (without using SendKeys) until I reach the text-area, right side of Folder.

2.
I would like to copy the manually typed text (in this case: "Wish to copy this selection").

3.
Then insert the text to a new Mail Item.
I would like to insert the text without using (see bold:
With OutlookMessage
.body = storeddata
End With

/you may ask why, it's because, what if I insert the text to another application (that application wont have .body).


Can you help me with this? I provide the initial code (with comments) I have for the whole macro.

PS: Is it possible to force the macro to work in the background without getting interrupted or copying from / insert to, wrong application?. ---->
Example of this problem occur when using sendkeys.
Say you are using a lot of sendkeys command, and all of a sudden middle of the macro another window pops up. The sendkeys will instead tab, enter, write etc in that window instead... And that is not good.


The initial part of the code:

Code:
Private Declare Function SendMessageString Lib "user32" Alias "SendMessageA" _
(ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long

 

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindow Lib "user32" _
(ByVal hWnd As Long, ByVal wCmd As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias "GetWindowTextLengthA" (ByVal hWnd As Long) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" (ByVal hWnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias _
    "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, _
    ByVal wParam As Long, lParam As Any) As Long

Private Const WM_GETTEXT = &HD
Private Const WM_GETTEXTLENGTH = &HE
Private Const WM_PASTE = &H302
Private Const WM_COPY = &H301
Private Const WM_SETTEXT = &HC

String/ Long /Object /etc values

Code:
Sub GetStringValue()

    Dim lHwnd As Long, stext As String, sTitle As String, lhwndparent As Long, lmainbody As Long

Dim sWinText As String, slen As Long, lret As Long

    Dim MyData As New DataObject    '<<<----- Had to enter this as code required an object for MyData.

    Set MyData = New DataObject      '<<<----- Had to enter this as code required an object for MyData.

    Dim MyStr As String
    Dim MailTOTEM As String
Dim OutlookMessage As Object
Dim oMailItem As MailItem

The next is almost half the SUB code
See me comments in the code. Also, I cant get this part to work as intended. Macro doesn't recognize "Map Network Drive" or it doesn't copy the field and doesn't tab the fields.

Code:
'The window we will be looking for is this name:
sTitle = "Map Network Drive"


lhwndparent = FindWindow(vbNullString, sTitle)
If lhwndparent <> 0 Then lmainbody = FindWindowEx(lhwndparent, 0&, "Edit", vbNullString)
If lmainbody <> 0 Then

JumpToPreviousControl (8)
'This should tab/jump all the way to our manually written text, the text area: right side of "Folder"


slen = SendMessage(lmainbody, WM_GETTEXTLENGTH, ByVal 0&, ByVal 0& + 1)

sWinText = Space(slen)
lret = SendMessage(lmainbody, WM_GETTEXT, ByVal slen, ByVal sWinText)
sWinText = Left(sWinText, lret)

Text1 = sWinText

End If

'The above should store the text as a string.



Code:
The next is almost half (and ending part of) the SUB code
See me comments in the code. Also, I can't get this part to work as intended. Macro doesn't recognize "Untitled - Message (HTML)" or it doesn't insert stored data.



Code:
'Now creating a new mail item.
Set OutlookMessage = CreateObject("Outlook.application").CreateItem(0)

MailTOTEM = "Untitled - Message (HTML)" 'this is the next application/window that I will insert my data.


    'Next we will store the data in the clipboard
stext = Text1
    MyData.SetText stext ' Had to give MyData an value or I receive an error.
    MyData.PutInClipboard
    stext = MyData.getText
    



    '~~> Find The Outlook mail
    lHwnd = FindWindow(vbNullString, MailTOTEM)


    
    '~~> Trying to Get Hold of the Edit Area of Outlook email item and insert the stored data.
    lHwnd = FindWindowEx(lHwnd, 0, "Edit", vbNullString)
    SendMessage lHwnd, WM_SETTEXT, 0, stext

’To display the result:
With OutlookMessage
.Display
End With

End Sub

Last is our Tab "function"
I want to avoid sendkeys.

Code:
' Jumps backward a specified number of times. Private Sub JumpToPreviousControl(ByVal times As Integer)
Dim i As Integer
For i = 1 To times
    SendKeys ("+{Tab}"), True
Next
End Sub
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top