Solved

vb6 programatically bring window to front

Posted on 2016-08-28
8
83 Views
Last Modified: 2016-09-13
Hello Experts,
We have this vb6 program that works just fine.
in certain feature it opens a word document and fills it with data.
The point is the word document gets opened on the back of all opened windows
and we would like it to open and come in front of all possible opened windows

What is the vb6 "source code / Command"  to send a programmatically opened word document to the front/top of all opened windows on the desktop ?

Regards,
0
Comment
Question by:rguillermo
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
  • 2
8 Comments
 
LVL 47

Expert Comment

by:Martin Liss
ID: 41773775
Please post the code that you use to open the Word document.
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 41773816
You will need to use the Windows API function SetWindowPos. An input to this must be the window handle. This needs to use the FindWindow function which itself needs the window caption. It is possible, though not advisable, to have more than one instance of Word running, so you would need to be sure that you choose the correct Window.

Here is a small project that I wrote some time ago. I hope it still works.
Project1.zip
0
 

Author Comment

by:rguillermo
ID: 41774363
Martin Liss, Here is the code,
GRaham Skan, we are testing your code.
Thank you

'*******************************************************************************
Option Explicit
      Dim THandle As Long

      Private Declare Function BringWindowToTop Lib "user32" (ByVal _
         hwnd As Long) As Long

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

Private Sub Form_Load()
Dim MyWord As Word.Application
Dim WordDoc As Word.Document
Dim MyRange As Word.Range
Dim MyTable As Word.Table
Dim MyCell As Word.Cell
Dim MyCells As Word.Cells
Dim MyCols As Word.Columns
Dim RetSt As String, retst1 As String, retst2 As String, w_tmp_fdr As String, iret As Long
Dim w_doc_des As String, W_FN       As String, w_tot_reg As String, w_spe_nam As String, w_date       As String, w_pat_cod As String, w_doc_ori As String, _
    w_int_nam As String, W_PAT_SEX As String, w_pat_dob As String, w_int_add As String, w_emp_MNE As String, w_pol_num As String, _
    w_ca2_des As String, w_cer_num As String, w_azv_cod As String, w_pra_cod As String, w_pra_nam As String, w_spe_cod As String, _
    w_wor_pla As String, w_emp_nam As String, W_TOTAL As Integer
Dim a As Integer, b As Integer, c As Integer, w As String, rv As Integer, op As Boolean, title As String
Dim fp As String, fn As String   ' fp = filepath , fn = filename
Dim data(40, 5)

retst1 = Chr(10) + Chr(13)
retst2 = Chr(13) + Chr(10)
RetSt = Chr(13)

Open "SS_tmp_fdr.txt" For Input As #1 Len = 100
  Input #1, w
  w_tmp_fdr = Trim(w)
Close #1

Open w_tmp_fdr & "AZV_DOC.txt" For Input As #1 Len = 200
  Input #1, w
  w_doc_ori = Trim(w)       'path doc origin
  Input #1, w
  w_doc_des = Trim(w)       'path doc destiny
  Input #1, w
  W_FN = Trim(w)            'file name word document
  Input #1, w
  w_tot_reg = Val(w)            'Total detail registers to read
  Input #1, w
  w_spe_nam = Trim(w)
  Input #1, w
  w_date = Trim(w)
  Input #1, w
  w_pat_cod = Trim(w)
  Input #1, w
  w_int_nam = Trim(w)
  Input #1, w
  W_PAT_SEX = Trim(w)
  Input #1, w
  w_pat_dob = Trim(w)
  Input #1, w
  w_int_add = Trim(w)
  Input #1, w
  w_emp_MNE = Trim(w)
  Input #1, w
  w_pol_num = Trim(w)
  Input #1, w
  w_ca2_des = Trim(w)
  Input #1, w
  w_cer_num = w
  Input #1, w
  w_azv_cod = Trim(w)
  Input #1, w
  w_pra_cod = Trim(w)
  Input #1, w
  w_pra_nam = Trim(w)
  Input #1, w
  w_spe_cod = Trim(w)
  Input #1, w
  w_wor_pla = Trim(w)
  Input #1, w
  w_emp_nam = Trim(w)
  W_TOTAL = 0
  For a = 1 To w_tot_reg
    Input #1, data(a, 1), data(a, 2), data(a, 3), data(a, 4), data(a, 5)
    W_TOTAL = W_TOTAL + Val(data(a, 4))
  Next a

Close #1

On Error GoTo W_END
Dim SourceFile, DestinationFile As String
SourceFile = w_doc_ori + W_FN
c = 1
Do While True
  fn = Left(W_FN, 3) + "_" + Mid(Str(1000000 + Val(w_pat_cod)), 2, 6) & "___" & dat_tim(Date + Time) + "_" + Chr(64 + c) + ".docx"
  fp = w_doc_des + fn
  op = local_file_exists(fp, fn)
  If Not op Then
    Exit Do
  End If
  c = c + 1
Loop

'fn = Left(W_FN, 3) + "_" + Mid(Str(1000000 + Val(w_pat_cod)), 2, 6) & "___" & dat_tim(Date + Time) + ".doc"
DestinationFile = w_doc_des + fn
FileCopy SourceFile, DestinationFile


Set MyWord = CreateObject("Word.Application")
Set WordDoc = MyWord.Documents.Open(DestinationFile)

MyWord.WindowState = wdWindowStateMaximize

MyWord.Visible = True
title = NameFromFullPath(DestinationFile)
'MsgBox (title)
THandle = FindWindow(vbEmpty, title)
iret = BringWindowToTop(THandle)
'    With Application
'        .WindowState = wdWindowStateNormal
'        .Width = 300
'        .Height = 300
'    End With
On Error GoTo 0

MyWord.WindowState = wdWindowStateMaximize
'  fn = Left(W_FN, 3) + "_" + Mid(Str(1000000 + Val(w_pat_cod)), 2, 6) & "___" & dat_tim(Date + Time)
'  fp = w_doc_des + fn
'  ActiveDocument.SaveAs FileName:=fp, FileFormat:= _
'        wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
'        False, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
'        False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
'        SaveAsAOCELetter:=False

  With MyWord
    .Selection.HomeKey Unit:=wdStory
    .Selection.MoveDown Unit:=wdLine, Count:=6
    .Selection.MoveRight Unit:=wdCell
   
    .Selection.EndKey Unit:=wdLine
    .Selection.TypeText Text:=w_pra_nam
   
    .Selection.MoveRight Unit:=wdCell
    .Selection.TypeText Text:=w_pra_cod
   
    .Selection.MoveLeft Unit:=wdCell
    .Selection.MoveDown Unit:=wdLine, Count:=1
   
    .Selection.EndKey Unit:=wdLine
    .Selection.TypeText Text:=w_spe_nam

    .Selection.MoveRight Unit:=wdCell
    .Selection.TypeText Text:=w_spe_cod
       
'    .Selection.MoveLeft Unit:=wdCell, Count:=3

    .Selection.MoveRight Unit:=wdCell, Count:=1
    .Selection.TypeText Text:=w_date
    .Selection.MoveRight Unit:=wdCell, Count:=1
    .Selection.EndKey Unit:=wdLine
    '.Selection.TypeText Text:=Chr(13)
    '.Selection.TypeText Text:=w_spe_cod
    '.Selection.MoveDown Unit:=wdLine, Count:=1
    '.Selection.MoveLeft Unit:=wdCell, Count:=3
    '.Selection.EndKey Unit:=wdLine
    .Selection.TypeText Text:=Chr(13) & "(" & w_pat_cod & ")"
   
    .Selection.MoveRight Unit:=wdCell, Count:=1
    .Selection.TypeText Text:=w_azv_cod & " - " & w_int_nam
   
    '.Selection.MoveRight Unit:=wdCell, Count:=1
    '.Selection.TypeText Text:=w_int_nam
    .Selection.HomeKey Unit:=wdLine, Extend:=wdExtend
    .Selection.Font.Name = "Arial Narrow"
    .Selection.Font.Bold = wdToggle
    .Selection.Font.Size = 12
   
    .Selection.MoveRight Unit:=wdCell, Count:=1
    .Selection.MoveDown Unit:=wdLine, Count:=1
    .Selection.TypeText Text:=w_pat_dob
   
    '.Selection.MoveDown Unit:=wdLine, Count:=1
    .Selection.HomeKey Unit:=wdLine
    .Selection.MoveLeft Unit:=wdCell, Count:=6
   
   
    If W_PAT_SEX = "v" Or W_PAT_SEX = "V" Or W_PAT_SEX = "2" Then
      .Selection.MoveRight Unit:=wdCell, Count:=3
      .Selection.EndKey Unit:=wdLine
      .Selection.TypeText Text:=W_PAT_SEX
      .Selection.MoveRight Unit:=wdCell, Count:=3
    ElseIf W_PAT_SEX = "m" Or W_PAT_SEX = "M" Or W_PAT_SEX = "1" Then
      .Selection.EndKey Unit:=wdLine
      .Selection.TypeText Text:=W_PAT_SEX
      .Selection.MoveRight Unit:=wdCell, Count:=6
    Else
      .Selection.MoveRight Unit:=wdCell, Count:=6
    End If
         
    .Selection.EndKey Unit:=wdLine
   
   
    .Selection.MoveDown Unit:=wdLine, Count:=2
   
    .Selection.EndKey Unit:=wdLine
    .Selection.TypeText Text:=w_int_add
   
    .Selection.MoveRight Unit:=wdCell, Count:=2
    .Selection.TypeText Text:=w_wor_pla
   
    .Selection.MoveRight Unit:=wdCell, Count:=2
    .Selection.TypeText Text:=w_pol_num
   
    .Selection.MoveRight Unit:=wdCell, Count:=2
    .Selection.TypeText Text:=w_emp_MNE   ' SDF
   
    .Selection.MoveRight Unit:=wdCell, Count:=2
    .Selection.TypeText Text:=w_cer_num
   
    .Selection.MoveDown Unit:=wdLine, Count:=1
    .Selection.HomeKey Unit:=wdLine
    .Selection.MoveDown Unit:=wdLine, Count:=2
   
    If w_tot_reg = 0 Then
      .Selection.MoveRight Unit:=wdCell, Count:=3
    End If
    For a = 1 To w_tot_reg
     
    .Selection.TypeText Text:=data(a, 1)
    .Selection.MoveRight Unit:=wdCell, Count:=1
     
    .Selection.TypeText Text:=data(a, 2)
    .Selection.MoveRight Unit:=wdCell, Count:=1
     
    .Selection.TypeText Text:=data(a, 3)
    .Selection.MoveRight Unit:=wdCell, Count:=1
     
    .Selection.TypeText Text:=data(a, 4)
           
    If a < w_tot_reg Then
      .Selection.InsertRowsBelow
      .Selection.HomeKey
    End If
  Next a
   
    .Selection.MoveDown Unit:=wdLine, Count:=1
    .Selection.TypeText Text:=Mid(Str(W_TOTAL + 0.001), 2, Len(Str(W_TOTAL + 0.001)) - 2)
   
   ActiveDocument.Save
  'ActiveDocument.SaveAs FileName:=fp, FileFormat:= _
  '      wdFormatDocument, LockComments:=False, Password:="", AddToRecentFiles:= _
  '      True, WritePassword:="", ReadOnlyRecommended:=False, EmbedTrueTypeFonts:= _
  '      False, SaveNativePictureFormat:=False, SaveFormsData:=False, _
  '      SaveAsAOCELetter:=False

  End With
W_END:
 
  Kill "c:\tmp\flag_azv_cod.txt"
  'Open "c:\tmp\flag_azv_cod.txt" For Output As #1
  'Write #1, "instance of azv_doc.exe FINISHED"
  'Close #1

  End
End Sub

Public Function dat_tim(x1)
  Dim v1, v2, v3, v4, v5, v6, v7, rp As String
 
  v1 = Mid(Str(Year(x1)), 2, 4)
  v2 = Mid(Str(100 + Month(x1)), 3, 2)
  v3 = Mid(Str(100 + Day(x1)), 3, 2)
  v4 = Mid(Str(100 + Hour(x1)), 3, 2)
  v5 = Mid(Str(100 + Minute(x1)), 3, 2)
  v6 = Mid(Str(100 + Second(x1)), 3, 2)
  v7 = "-"
  rp = v1 + v7 + v2 + v7 + v3 + "_" + v4 + v7 + v5 + v7 + v6
  dat_tim = rp
 
End Function

Public Function local_file_exists(asPath, asfile As String) As Boolean
  ' aspath = filespec
  ' asfile = filename
  Dim x As String
 
  x = UCase(Dir(asPath))
  If UCase(Dir(asPath)) = UCase(Trim(asfile)) Then
    local_file_exists = True
  Else
    local_file_exists = False
  End If
End Function

Public Function NameFromFullPath(FullPath As String) As String
'Input: Name/Full Path of a file
'Returns: Name of file

    Dim sPath As String
    Dim sList() As String
    Dim sAns As String
    Dim iArrayLen As Integer

    If Len(FullPath) = 0 Then Exit Function
    sList = Split(FullPath, "\")
    iArrayLen = UBound(sList)
    sAns = IIf(iArrayLen = 0, "", sList(iArrayLen))
       
    NameFromFullPath = sAns ' Mid(sAns, 1, InStrRev(sAns, ".") - 1) ' + " - Microsoft Word"

End Function
0
Industry Leaders: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:rguillermo
ID: 41778235
GrahamSkan,
Your example, when compiled and executed also opens a word document but it stays behing the window that call it.. any way to call from your executable and get word on top ?
Regards!
0
 
LVL 76

Expert Comment

by:GrahamSkan
ID: 41778262
I think the circumstances were different, but it was eight years ago. If Martin doesn't get there first, I will try to fit it to your code, but it might take a while.
0
 
LVL 47

Accepted Solution

by:
Martin Liss earned 500 total points
ID: 41778289
Try this. Add this API

    Private Declare Function SetForegroundWindow Lib "user32" (ByVal hwnd As Long) As Long

and then modify this portion of your code.

MyWord.Visible = True
title = NameFromFullPath(DestinationFile)
'MsgBox (title)
THandle = FindWindow(vbEmpty, title)
iret = BringWindowToTop(THandle)
'    With Application
'        .WindowState = wdWindowStateNormal
'        .Width = 300
'        .Height = 300
'    End With
If THandle > 0 Then
      SetForegroundWindow (THandle)
End If

On Error GoTo 0
0
 

Author Closing Comment

by:rguillermo
ID: 41797260
A little hint.... when using this features pay good attention at the name of the window it can add some tezt at the end according to circumstances...of each instance in each station....  just observe and test.. you will find several texts that are added... adapt your function and works just fine..
thank you experts, the proposed solution works just fine...
Thanks to all experts!!
0
 

Author Comment

by:rguillermo
ID: 41797261
correction: its TEXT instead of tezt or test
0

Featured Post

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

No matter the version of Windows you are using, you may have some problems with Windows Search running too slow or possibly not running at all. Before jumping into how you can solve this issue, just know there are many other viable alternative deskt…
Access developers frequently have requirements to interact with Excel (import from or output to) in their applications.  You might be able to accomplish this with the TransferSpreadsheet and OutputTo methods, but in this series of articles I will di…
This video shows where to find the word count, how to display it, and what it breaks down to in Microsoft Word.
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question