Solved

vb6 programatically bring window to front

Posted on 2016-08-28
8
93 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 48

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
Office 365 Training for IT Pros

Learn how to provision tenants, synchronize on-premise Active Directory, implement Single Sign-On, customize Office deployment, and protect your organization with eDiscovery and DLP policies.  Only from Platform Scholar.

 

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 48

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

Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

Question has a verified solution.

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

Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
This article helps those who get the 0xc004d307 error when trying to rearm (reset the license) Office 2013 in a Virtual Desktop Infrastructure (VDI) and/or those trying to prep the master image for Microsoft Key Management (KMS) activation. (i.e.- C…
The viewer will learn how to create two correlated normally distributed random variables in Excel, use a normal distribution to simulate the return on different levels of investment in each of the two funds over a period of ten years, and, create a …
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 …
Suggested Courses
Course of the Month11 days, 7 hours left to enroll

623 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