Solved

vb6 programatically bring window to front

Posted on 2016-08-28
8
52 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
  • 4
  • 2
  • 2
8 Comments
 
LVL 45

Expert Comment

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

Expert Comment

by:GrahamSkan
Comment Utility
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
Comment Utility
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
 

Author Comment

by:rguillermo
Comment Utility
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
Free Trending Threat Insights Every Day

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
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 45

Accepted Solution

by:
Martin Liss earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
correction: its TEXT instead of tezt or test
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

Recently Microsoft released a brand new function called CONCAT. It's supposed to replace its predecessor CONCATENATE. But how does it work? And what's new? In this article, we take a closer look at all of this - we even included an exercise file for…
In this article we discuss how to recover the missing Outlook 2011 for Mac data like Emails and Contacts manually.
Learn how to make your own table of contents in Microsoft Word using paragraph styles and the automatic table of contents tool. We'll be using the paragraph styles in Word’s Home toolbar to help you create a table of contents. Type out your initial …
Learn how to create and modify your own paragraph styles in Microsoft Word. This can be helpful when wanting to make consistently referenced styles throughout a document or template.

744 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

Need Help in Real-Time?

Connect with top rated Experts

8 Experts available now in Live!

Get 1:1 Help Now