Solved

vb6 programatically bring window to front

Posted on 2016-08-28
8
63 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 46

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
 

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
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
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 46

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

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Spell checking an unbound form in MS Access 2013 9 58
Convert .PDF 6 60
Keyboard shortcuts for Back & Forward QAT arrows in Excel 3 56
Generating a graph via Excel 3 26
This article describes how to use the Send to Mail Recipient command. The instructions apply generally to Office 2007 and later versions, but Microsoft® Word 2013 was used for the specific steps and figures.  What is Send to Mail Recipient? Send…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
This Micro Tutorial well show you how to find and replace special characters in Microsoft Word. This is similar to carriage returns to convert columns of values from Microsoft Excel into comma separated lists.
Access reports are powerful and flexible. Learn how to create a query and then a grouped report using the wizard. Modify the report design after the wizard is done to make it look better. There will be another video to explain how to put the final p…

920 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

14 Experts available now in Live!

Get 1:1 Help Now