Concatenate 2 or more files using windows dailog box

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

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

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

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

Brian

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

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

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!

Believer,

Would you send it to me?

Thanks.

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.

Believer,

Can you send it to me as well?

Thanks.

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

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

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

All of the selections are here:

    : Win_Struct.lpstrFile: "C:\6133
Addresses.xls
2-4.exe
1 27.doc












































































































































"

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

Brian

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

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?

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)