Go Premium for a chance to win a PS4. Enter to Win

x
?
Solved

Concatenate 2 or more files using windows dailog box

Posted on 2000-03-16
18
Medium Priority
?
346 Views
Last Modified: 2010-05-18
I have a need to concatenate 2 more files.  The user will choose the files via the windows dialog box (I need the dialog box to allow the user to choose more than one file - similiar to holding down the ctrl/left click buttons).  Then shell out (maybe?) and run the copy command (copy filename1 + filename2 output.txt).

Does anyone have any ideas?  

I already have the code to show a windows dialog box but it only allows you to choose one file.

Also, there may be a chance (small chance but none the less I need to code for the 1%) that there will be one file.  The code will need to handle this situation.

Thanks.
0
Comment
Question by:martinre
  • 8
  • 5
  • 3
  • +2
18 Comments
 
LVL 9

Expert Comment

by:BrianWren
ID: 2625572
Out of my module for APIs...

Global Const AllowMultiSelect = &H200    ' FileOpen only. The szFile member will contain path, _
                                           followed by all files w/in that path that were _
                                           chosen, separated by Spaces.

Brian
0
 
LVL 9

Expert Comment

by:BrianWren
ID: 2625597
I think that to pull this off gracefully, you will wind up needing to actually open the files, and read then into the resultant file, one file at a time.

Access' FileCopy command will apparently not accept the format of

FileCopy "<File1> + <File2>", "<File3>"

If you shell out and use a DOS command, the screen will switch to test mode...

If you do the copying yourself, you can ascertain the sizes of the files beforehand, and present a nice little progress meter...

Brian
0
 
LVL 4

Expert Comment

by:mberumen
ID: 2625632
"I already have the code to show a windows dialog box but it only allows you to choose one file. "

your dialog box probably has a setting to allow you to select more that one entry look for a property that looks like "multiselect" and assign it a different value.

could you tell us which control you are using to display the files?
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
LVL 9

Expert Comment

by:BrianWren
ID: 2625647
(I should have mentioned in my first post: that constant is the value and name for the Flags member of the FileOpen dialog...)

Brian
0
 
LVL 7

Expert Comment

by:Believer
ID: 2625841
Since BrianWren says that Access' FileCopy command won't handle file1+file2-->FileOut, create the DOS command (which I think you were originally referring to) and save it to a .bat file you can run.
As for selecting multiple files, I'll have to get back to you tomorrow because I'm at home for the evening and all my valuable resources are at work :)
0
 
LVL 9

Expert Comment

by:BrianWren
ID: 2625917
The common dialog control, and the structure for the FileOpen API both have a 'Flags' element.  In the one it is a property, in the other it is an element of the structure.  In both cases, you set the value (through addition) according to the behavior that you are after.

If you want to not allow the selection of ReadOnly files, then set the Flags to &H8000&, (32768).

If you want to prompt the user regarding creating a not-yet-existing file, the value is &H2000.  If there is to be no test file created, (to make sure that the file CAN be created), the value would be &H10000.  For BOTH a create prompt, and no test file creation, it would be "&H2000 + &H10000".

So you would have, (in snippets):

Global Const NoTestFileCreate = &H10000
Global Const CreatePrompt = &H2000

 . . .

   Me!CmnDlg.Flags = NoTestFileCreate + CreatePrompt

In your case, the flag would contain the value &H200 (which = 512...).

Brian
0
 
LVL 7

Expert Comment

by:Believer
ID: 2628014
To all who are reading this:
The Access (97) Developer's Handbook has a really cool form for testing a version of the open file dialog box.  I made some slight changes to it and also created a similar for for testing the common dialog ActiveX control.  Here's how they both work:

A pop-up form lets you set (nearly?) all of the parameters, then test the configuration with the click of a button.  Want to know how a dialog box is going to look and behave?  This is your tool!  In addition, there's another button that pastes code to a pop-up window based on the settings you've selected.  For the most part, all you have to do is cut&paste that code to your application.

If any of y'all are interested in having this tool, gimme your e-mail address and it shall be done!
0
 
LVL 9

Expert Comment

by:BrianWren
ID: 2628460
Believer,

Would you send it to me?

Thanks.
0
 

Author Comment

by:martinre
ID: 2629864
BrianWren,

I have made the change to allow multi selects in the windows dialog box (AllowMultiSelect = &H200).  But now the return value only bring back the directory name.  

Any clues?  Thanks for the help.
0
 

Author Comment

by:martinre
ID: 2629867
Believer,

Can you send it to me as well?

Thanks.
0
 
LVL 9

Expert Comment

by:BrianWren
ID: 2629985
The advertisment from MS says

The szFile member will contain path, followed by all files w/in that path that were chosen, separated by Spaces.

What I get is:

C:\Access\Color Control.mdb<tab>C:\Access\FileOpen.mdb

(tab delimited)

So I guess that I would use InStr(Me!CmnDlg.File, Chr$(9)) to search the string.

(Or perhaps InStr(Me!CmnDlg.FileName, Chr$(9)).  I can never keep straight which of those two properties has which piece of info in it...)

BTW, the file that you asked to get above uses a DLL-type call into the exposed function of MsAccess.exe, #56.  It will help you a bit with the common dialog control, but there will be differences...

When I deliberately fed a bogus flag value to the test form, it shut Access down when I clicked the 'Test' button...  (It only killed that instance of Access though...)

Brian
0
 
LVL 7

Expert Comment

by:Believer
ID: 2631719
martinre: I need your e-mail address.
BrianWren: Are you referring to the tool I sent you?  If so, there are two forms in that mdb, one uses msaccess.exe, the other uses the ocx.  Yes, there are differences, and it's interesting to examine the two and see what functionality is offered by each.  An advantage of the msaccess.exe approach is that you don't need to register another control on the user's machine.
You also said you "deliberately fed a bogus flag value to the test form" - how'd you do that?  Bybass the interface?  Just curious!
I appreciate the feedback I can get back on the tool(s) because I have been long considering send them to a magazine for publication.  (Of course, I will have to address the issue that the original form came from Litwin/Getz/et al.)
0
 

Author Comment

by:martinre
ID: 2636419
BrianWren,

Here is the code I am using.  I did a copy/paste so if it to hard to read send me your email address and I will send it to you.

For some reason my return value is the directory name (this happens when I select multiple files).  Everything is fine if I select one file.

The call to this function is:  importfilename = GetOpenFile_API("F:\", "Import File")

I suspect part of the problem is in the function "ConvertAPI2Win" where lpstrFile is set.  And in function "ConvertWin2API" where strFullPathReturned is set.

I went into debug and analyzed lpstrFile and saw the return value had a null behind the directory name and a several null after that.  It appears lpstrFile is initially set with nulls.  It also looks as if when I select multiple files, a begin and end double quote is inserted for each filename but I did not see them in debug.

I am brain dead already this Monday a.m. Hope you can help.  I'm sure you with your experience you can see the problem right off.

Here is the code:

Option Compare Database
' Declarations for Windows Common Dialogs procedures
Private Type API_OPENFILE
  strFilter As String             ' Filter string
  intFilterIndex As Long          ' Initial Filter to display.
  strInitialDir As String         ' Initial directory for the dialog to open in.
  strInitialFile As String        ' Initial file name to populate the dialog with.
  strDialogTitle As String        ' Dialog title
  strDefaultExtension As String   ' Default extension to append to file if user didn't specify one.
  lngFlags As Long                ' Flags (see constant list) to be used.
  strFullPathReturned As String   ' Full path of file picked.
  strFileNameReturned As String   ' File name of file picked.
  intFileOffset As Integer        ' Offset in full path (strFullPathReturned) where the file name (strFileNameReturned) begins.
  intFileExtension As Integer     ' Offset in full path (strFullPathReturned) where the file extension begins.
End Type

Const ALLFILES = "All Files"

Private Type API_WINOPENFILENAME
    lStructSize As Long
    hWndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustrFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustrData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Const OFN_ALLOWMULTISELECT = &H200
Const OFN_CREATEPROMPT = &H2000
Const OFN_EXPLORER = &H80000
Const OFN_FILEMUSTEXIST = &H1000
Const OFN_HIDEREADONLY = &H4
Const OFN_NOCHANGEDIR = &H8
Const OFN_NODEREFERENCELINKS = &H100000
Const OFN_NONETWORKBUTTON = &H20000
Const OFN_NOREADONLYRETURN = &H8000
Const OFN_NOVALIDATE = &H100
Const OFN_OVERWRITEPROMPT = &H2
Const OFN_PATHMUSTEXIST = &H800
Const OFN_READONLY = &H1
Const OFN_SHOWHELP = &H10

Declare Function API_GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
  (pOpenfilename As API_WINOPENFILENAME) _
As Boolean
   
Declare Function API_GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
  (pOpenfilename As API_WINOPENFILENAME) _
As Boolean
   
Declare Sub API_ChooseColor Lib "msaccess.exe" Alias "#53" _
  (ByVal hwnd As Long, rgb As Long)

Function CreateFilterString_API(ParamArray varFilt() As Variant) As String
  ' Comments  : Builds a Windows formatted filter string for "file type"
  ' Parameters: varFilter - parameter array in the format:
  '                          Text, Filter, Text, Filter ...
  '                         Such as:
  '                          "All Files (*.*)", "*.*", "Text Files (*.TXT)", "*.TXT"
  ' Returns   : windows formatted filter string
  '
  Dim strFilter As String
  Dim intCounter As Integer
  Dim intParamCount As Integer

  On Error GoTo PROC_ERR
   
  ' Get the count of paramaters passed to the function
  intParamCount = UBound(varFilt)
   
  If (intParamCount <> -1) Then
     
    ' Count through each parameter
    For intCounter = 0 To intParamCount
      strFilter = strFilter & varFilt(intCounter) & Chr$(0)
    Next
     
    ' Check for an even number of parameters
    If (intParamCount Mod 2) = 0 Then
      strFilter = strFilter & "*.*" & Chr$(0)
    End If
     
  End If

  CreateFilterString_API = strFilter
   
PROC_EXIT:
  Exit Function
   
PROC_ERR:
  CreateFilterString_API = ""
  Resume PROC_EXIT
   
End Function

Function RemoveNulls(strIn As String) As String
  ' Comments  : Removes terminator from a string
  ' Parameters: strIn - string to modify
  ' Return    : modified string
  '
  Dim intChr As Integer

  intChr = InStr(strIn, Chr$(0))

  If intChr > 0 Then
    RemoveNulls = Left$(strIn, intChr - 1)
  Else
    RemoveNulls = strIn
  End If

End Function

Sub ConvertAPI2Win(API_Struct As API_OPENFILE, Win_Struct As API_WINOPENFILENAME)
  ' Comments  : Converts the passed API structure to a Windows structure
  ' Parameters: API_Struct - record of type API_OPENFILE
  '             Win_Struct - record of type API_WINOPENFILENAME
  ' Returns   : Nothing
  '
  Dim strFile As String * 512

  On Error GoTo PROC_ERR
   
  Win_Struct.hWndOwner = Application.hWndAccessApp
  Win_Struct.hInstance = 0

  If API_Struct.strFilter = "" Then
    Win_Struct.lpstrFilter = ALLFILES & Chr$(0) & "*.*" & Chr$(0)
  Else
    Win_Struct.lpstrFilter = API_Struct.strFilter
  End If
  Win_Struct.nFilterIndex = API_Struct.intFilterIndex

  If API_Struct.strInitialFile <> "" Then
    Win_Struct.lpstrFile = API_Struct.strInitialFile & String$(512 - Len(API_Struct.strInitialFile), 0)
  Else
    Win_Struct.lpstrFile = String(512, 0)
 End If
   
  Win_Struct.nMaxFile = 511
   
  Win_Struct.lpstrFileTitle = String$(512, 0)
  Win_Struct.nMaxFileTitle = 511

  Win_Struct.lpstrTitle = API_Struct.strDialogTitle
  Win_Struct.lpstrInitialDir = API_Struct.strInitialDir
' Win_Struct.lpstrInitialDir = "F:\"
  Win_Struct.lpstrDefExt = API_Struct.strDefaultExtension

  Win_Struct.Flags = API_Struct.lngFlags

  Win_Struct.lStructSize = Len(Win_Struct)
   
PROC_EXIT:
  Exit Sub
   
PROC_ERR:
  Resume PROC_EXIT
   
End Sub

Sub ConvertWin2API(Win_Struct As API_WINOPENFILENAME, API_Struct As API_OPENFILE)
  ' Comments  : Converts the passed API structure to a Windows structure
  ' Parameters: Win_Struct - record of type API_WINOPENFILENAME
  '             API_Struct - record of type API_OPENFILE
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR
       
  API_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar) - 1)
  API_Struct.strFileNameReturned = RemoveNulls(Win_Struct.lpstrFileTitle)
  API_Struct.intFileOffset = Win_Struct.nFileOffset
  API_Struct.intFileExtension = Win_Struct.nFileExtension
   
PROC_EXIT:
  Exit Sub
   
PROC_ERR:
  Resume PROC_EXIT
   
End Sub

Function GetOpenFile_API(strInitialDir As String, strTitle As String) As String
  ' Comments  : Simple file open routine.
  ' Parameters: strInitialDir - path for the initial directory, or blank for the current directory
  '             strTitle - title for the dialog
  ' Returns   : string path, name and extension of the file selected
  '
  Dim fOK As Boolean
  Dim typWinOpen As API_WINOPENFILENAME
  Dim typOpenFile As API_OPENFILE
  Dim strFilter As String
   
  On Error GoTo PROC_ERR
   
  ' Set reasonable defaults for the structure
  strFilter = CreateFilterString_API("All Files (*.*)", "*.*", "Database Files (*.TXT)", "*.TXT")  ' I believe that you named your database files TXT.  Others should use MDB instead.
   
  If strInitialDir <> "" Then
    typOpenFile.strInitialDir = strInitialDir
  Else
    typOpenFile.strInitialDir = CurDir()
  End If
   
  If strTitle <> "" Then
    typOpenFile.strDialogTitle = strTitle
  End If
   
  typOpenFile.strFilter = strFilter
  typOpenFile.lngFlags = OFN_HIDEREADONLY Or OFN_SHOWHELP Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER
   
  ' Convert the API structure to a Win structure
  ConvertAPI2Win typOpenFile, typWinOpen
   
  ' Call the Common dialog
  fOK = API_GetOpenFileName(typWinOpen)
   
  ' Convert the Win structure back to a API structure
  ConvertWin2API typWinOpen, typOpenFile
   
  GetOpenFile_API = typOpenFile.strFullPathReturned
       
PROC_EXIT:
  Exit Function
   
PROC_ERR:
  GetOpenFile_API = ""
  Resume PROC_EXIT

End Function
0
 
LVL 9

Expert Comment

by:BrianWren
ID: 2637283
All of the selections are here:

    : Win_Struct.lpstrFile: "C:\6133Addresses.xls2-4.exe1 27.doc"

When that value is put into API_Struct.strFullPathReturned in Sub ConvertWin2API() the contents are lost.

Brian
0
 
LVL 9

Accepted Solution

by:
BrianWren earned 400 total points
ID: 2637320
The format is
<Path> Null <File1> Null <File2> Null

I would write a function to get the individual names by looking for a pair of nulls.

NullLoc = InStr(Win_Struct.lpstrFile, Chr$(0))
Path = Left$(Win_Struct.lpstrFile, NullLoc - 1)
OldNullLoc = NullLoc
NullLoc = InStr(OldNullLoc+1,Win_Struct.lpstrFile, Chr$(0))
If OldNullLoc + 1 = NullLoc Then ' Done
File1 = Path & Mid$(Win_Struct.lpstrFile, OldNullLoc + 1, NullLoc - OldNullLoc - 2)


BTW, your code would be easier to read if you set your tab to 4 spaces instead of 2...

Brian
0
 

Author Comment

by:martinre
ID: 2640786
Brian,

here is what I did:

1.  I changed convertwin2api to look for 2 null chars

Sub ConvertWin2API(Win_Struct As API_WINOPENFILENAME, API_Struct As API_OPENFILE)
  ' Comments  : Converts the passed API structure to a Windows structure
  ' Parameters: Win_Struct - record of type API_WINOPENFILENAME
  '             API_Struct - record of type API_OPENFILE
  ' Returns   : Nothing
  '
  On Error GoTo PROC_ERR

  API_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, vbNullChar & vbNullChar) - 1)
'  API_Struct.strFullPathReturned = Left(Win_Struct.lpstrFile, InStr(Win_Struct.lpstrFile, PairNulls, 1) - 2)
  API_Struct.strFullPathReturned = ReplaceChr(API_Struct.strFullPathReturned)
' API_Struct.strFileNameReturned = RemoveNulls(Win_Struct.lpstrFileTitle)
  API_Struct.intFileOffset = Win_Struct.nFileOffset
  API_Struct.intFileExtension = Win_Struct.nFileExtension
   
PROC_EXIT:
  Exit Sub
   
PROC_ERR:
  Resume PROC_EXIT
   
End Sub


2.  I then wrote a function called "replacechr" that will search through the string and build a new string with double quotes and a + sign to signify concatenation.

Function ReplaceChr(anyValue As Variant) As Variant
' Accepts: a text value
' Purpose: replaces null char with a space
' Returns: converted text value

    Dim ptr As Integer
    Dim theString As String
    Dim currChar As String
    Dim newstring As String
    Dim path As String
    Dim NullLoc As String
    Dim StringLength As String
       
    If IsNull(anyValue) Then
        Exit Function
    End If

    theString = CStr(anyValue)
    StringLength = Len(theString)
    NullLoc = InStr(theString, vbNullChar)
    path = Left$(theString, NullLoc - 1) & "\"
   
    For ptr = 1 To Len(theString)           'Go through string char by char.
        currChar = Mid$(theString, ptr, 1)  'Get the current character.
 
        Select Case currChar            'If previous char is a null char
                                            'this char should be a space
            Case vbNullChar
'               Mid(theString, ptr, 1) = vbspace
                If ptr = NullLoc Then
                   newstring = Chr(34) & path
                Else
                   newstring = newstring & Chr(34) & "+" & Chr(34) & path
                End If
            Case Else
'               Mid(theString, ptr, 1) = currChar
                newstring = newstring & currChar
 
        End Select
 
    Next ptr

    ReplaceChr = CVar(newstring) & Chr(34)

End Function


3.  I then write a subroutine to shell out and copy multiple files to a single file.

Sub MyOwnCopyFileFunction(SourceFile As String, DestFile As String)

      '---------------------------------------------------------------
      ' PURPOSE: Copy a file on disk from one location to another.
      ' ACCEPTS: The name of the source file and destination file.
      ' RETURNS: Nothing
      '---------------------------------------------------------------
         Dim CopyString As String
'        If Dir(SourceFile) = "" Then
'           MsgBox Chr(34) & SourceFile & Chr(34) & _
'              " is not a valid file name."
'        Else
'           SourceFile = Chr(34) & SourceFile & Chr(34)
'           DestFile = Chr(34) & DestFile & Chr(34)
            CopyString = "CMD.EXE /C COPY " & SourceFile & _
               " " & DestFile
            Call Shell(CopyString, 0)
'        End If

'   If you are using Microsoft Windows NT, use the same procedure, but
'   change the line

'      CopyString = "COMMAND.COM /C COPY " & SourceFile & _

'   to:

'      CopyString = "CMD.EXE /C COPY " & SourceFile & _

End Sub

Everything seems to work fine now.  Thanks for the help!!!

0
 

Author Comment

by:martinre
ID: 2640808
Brian,

I gave you the points but it is now reading 10 points instead of the 100 I first assigned to this question.

Any ideas?

0
 
LVL 2

Expert Comment

by:lightcross
ID: 11119942
You will need to set the flags portion like this example below:

 varFileArray = ahtCommonFileOpenSave(InitialDir:="strFilter", _
      Filter:=strFilter, FilterIndex:=1, Flags:=ahtOFN_ALLOWMULTISELECT + ahtOFN_EXPLORER, _
      DialogTitle:="Save File As", _
      openFile:=True)

or

 varFileArray = ahtCommonFileOpenSave(InitialDir:="strFilter", _
      Filter:=strFilter, FilterIndex:=1, Flags:=ahtOFN_ALLOWMULTISELECT, _
      DialogTitle:="Save File As", _
      openFile:=True)
0

Featured Post

Important Lessons on Recovering from Petya

In their most recent webinar, Skyport Systems explores ways to isolate and protect critical databases to keep the core of your company safe from harm.

Question has a verified solution.

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

This article describes a method of delivering Word templates for use in merging Access data to Word documents, that requires no computer knowledge on the part of the recipient -- the templates are saved in table fields, and are extracted and install…
Windows Explorer let you handle zip folders nearly as any other folder: Copy, move, change, and delete, etc. In VBA you can also handle normal files and folders, but zip folders takes a little more - and that you'll find here.
In Microsoft Access, learn different ways of passing a string value within a string argument. Also learn what a “Type Mis-match” error is about.
Do you want to know how to make a graph with Microsoft Access? First, create a query with the data for the chart. Then make a blank form and add a chart control. This video also shows how to change what data is displayed on the graph as well as form…

972 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