×
INTELLIGENT WORK FORUMS
FOR COMPUTER PROFESSIONALS

Log In

Come Join Us!

Are you a
Computer / IT professional?
Join Tek-Tips Forums!
  • Talk With Other Members
  • Be Notified Of Responses
    To Your Posts
  • Keyword Search
  • One-Click Access To Your
    Favorite Forums
  • Automated Signatures
    On Your Posts
  • Best Of All, It's Free!
  • Students Click Here

*Tek-Tips's functionality depends on members receiving e-mail. By joining you are opting in to receive e-mail.

Posting Guidelines

Promoting, selling, recruiting, coursework and thesis posting is forbidden.

Students Click Here

Jobs

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

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

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

(OP)
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...
http://i49.tinypic.com/63srqe.jpg

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

Red Flag This Post

Please let us know here why this post is inappropriate. Reasons such as off-topic, duplicates, flames, illegal, vulgar, or students posting their homework.

Red Flag Submitted

Thank you for helping keep Tek-Tips Forums free from inappropriate posts.
The Tek-Tips staff will check this out and take appropriate action.

Reply To This Thread

Posting in the Tek-Tips forums is a member-only feature.

Click Here to join Tek-Tips and talk with other members!

Close Box

Join Tek-Tips® Today!

Join your peers on the Internet's largest technical computer professional community.
It's easy to join and it's free.

Here's Why Members Love Tek-Tips Forums:

Register now while it's still free!

Already a member? Close this window and log in.

Join Us             Close