Solved

vb6 programatically bring window to front

Posted on 2016-08-28
8
74 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
Networking for the Cloud Era

Join Microsoft and Riverbed for a discussion and demonstration of enhancements to SteelConnect:
-One-click orchestration and cloud connectivity in Azure environments
-Tight integration of SD-WAN and WAN optimization capabilities
-Scalability and resiliency equal to a data center

 

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 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

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

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

Suggested Solutions

Title # Comments Views Activity
Web Query 1 19
Combine like values in a graph excel 2016 7 30
Excel Split Employee Name into Lname Fname Mname 3 15
Clear a Text Box 7 23
Entering a date in Microsoft Access can be tricky. A typo can cause month and day to be shuffled, entering the day only causes an error, as does entering, say, day 31 in June. This article shows how an inputmask supported by code can help the user a…
This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
The viewer will learn how to simulate a series of coin tosses with the rand() function and learn how to make these “tosses” depend on a predetermined probability. Flipping Coins in Excel: Enter =RAND() into cell A2: Recalculate the random variable…
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 …

840 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