multiple select dialog bombs when only 1 file is selected

Here is the code that i am using.  Some of you might be familiar with the ahtCommonMultiFileOpenSave so I wont get into specifics with that.  I just need to know why it bombs when the user only selects 1 file.  It works perfect when the user selects multiple files though.


The error that I get says "filename too long".






'BROWSE AND SELECT FILE FOR LOAD/IMPORT     ***** BEGIN
    'related variables
Dim strFilter As String
Dim lngFlags As Long
Dim varFiles As String
Dim lFlags As Long
Dim varVariant As Variant
Dim varInt As Integer
Dim sFilter As String
Dim s() As String
Dim varImage As String
Dim Fields
Dim varFileName As String
Dim varFileExtension As String
Dim varFileRev As String

lFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER

    'On Error GoTo CancelSelected

   strFilter = ahtAddFilterItem(strFilter, "Raw Data Testing Files(*.txt)", _
                   "*.TXT")
varFiles = ahtCommonMultiFileOpenSave(InitialDir:=sFilter, _
                filter:=sFilter, FilterIndex:=1, flags:=lFlags, _
                DialogTitle:="Select File(s)")
               
If varFiles = "" Or varFiles = "NoFile" Then
    GoTo CancelSelected
End If


varVariant = Split(varFiles, ";")


For varInt = LBound(varVariant) To UBound(varVariant)
    varFiles = varVariant(varInt)
    s = Split(varFiles, "\")
        varImage = s(UBound(s))
       
       
    Fields = Split(varImage, ".")
        varFileName = Fields(0)
        varFileExtension = UCase(Fields(1))
        varFileRev = "1"
        'MsgBox "Processing - " & varFiles & ""
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TABLE - SWSRawUsername     ***** BEGIN
Dim varRawTable As String
varRawTable = "SWSRaw-" & CurrentUser()

'checks if table exists in db, if it does it will be deleted
If acbDoesObjExist("" & varRawTable, acTable) Then
DoCmd.DeleteObject acTable, "SWSRaw-" & CurrentUser()
End If
MsgBox varFiles
DoCmd.TransferText "transfertype" = "acImportDelimited", _
         specificationname:="DataImportVersion1 ", _
         TableName:="" & varRawTable, _
               Filename:=varFiles, _
               hasfieldnames:=False

Next varInt
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TABLE - SWSRawUsername     ***** END


LVL 2
lightcrossAsked:
Who is Participating?
 
rockiroadsConnect With a Mentor Commented:
Ok, the API call returns the filename with the extra characters on the end, this may have somethng to do with the string definition (length is supplied)
e.g..

strFileName = Left(Filename & String(6000, 0), 6000)
strFileTitle = String(6000, 0)

The API call passes in a string sized to a certain length, if this is not done, u may get an overflow



Now, I have found my version which is a bit similar,


If u look in the ahtCommonMultiDialog call

it trims the field, but a regular trim does not remove it

For I = LBound(sFiles) + 1 To UBound(sFiles)

'TRIM HERE
            If sFiles(I) <> vbNullChar And Trim$(sFiles(I)) <> "" Then
                If ahtCommonMultiFileOpenSave <> "" Then ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & ";"
                ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & sDrive & sFiles(I)
            End If
        Next I
       
'SETTING THE FILE IF ONE SELECTED
        If ahtCommonMultiFileOpenSave = "" And OFN.strFile <> "" Then ahtCommonMultiFileOpenSave = OFN.strFile


What I did was to make use of the TrimNull function and change the code
e.g.

        For I = LBound(sFiles) + 1 To UBound(sFiles)

'IF YOU ARE HAPPY WITH TRIM THEN LEAVE THAT OTHERWISE TRY THIS
            If sFiles(I) <> vbNullChar And TrimNull(sFiles(I)) <> "" Then
                If ahtCommonMultiFileOpenSave <> "" Then ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & ";"
                ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & sDrive & sFiles(I)
            End If
        Next I
       

'IT IS DEFIINTELY REQUIRED HERE
        If ahtCommonMultiFileOpenSave = "" And OFN.strFile <> "" Then ahtCommonMultiFileOpenSave = TrimNull(OFN.strFile)




And here is TrimNull

Private Function TrimNull(ByVal strItem As String) As String
   
    Dim intPos As Integer
   
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function




TrimNull is a function found quite a lot on forums, its useful for stripping strings that have been sized and used in API calls.

0
 
rockiroadsCommented:
what is the reason to split the file to get tje suffix/prefix?

this bit I mean as I cant see anything u do with it

 varFiles = varVariant(varInt)
    s = Split(varFiles, "\")
        varImage = s(UBound(s))
       
       
    Fields = Split(varImage, ".")
        varFileName = Fields(0)
        varFileExtension = UCase(Fields(1))
        varFileRev = "1"
        'MsgBox "Processing - " & varFiles & ""



what is varVariant doing?

0
 
lightcrossAuthor Commented:
i cut the code short because its really irrelevant.  sorry, i should have left that out.
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
lightcrossAuthor Commented:
the code fails at:

DoCmd.TransferText "transfertype" = "acImportDelimited", _
         specificationname:="DataImportVersion1 ", _
         TableName:="" & varRawTable, _
               Filename:=varFiles, _
               hasfieldnames:=False
0
 
rockiroadsCommented:
have u tried manually importing the file ? hardcode the names in a test

also I dont think acImportDelimited has to be in double quotes,

have u confirmed all variables have a valid value?
0
 
lightcrossAuthor Commented:
I found the problem.  It is in here:

varVariant = Split(varFiles, ";")

i guess if the string only has one file it looks like this:
c:\directory\1file.txt

otherwise it would look like this on a multiple select:
c:\directory\1file.txt;c:\c:\directory\2file.txt

it assigns a null value to varVariant if it is only 1 file???  how can i handle this?
0
 
rockiroadsCommented:
when u split, whether it finds the delimiter or not, there should always be a value in subscript 0
perhaps if u define it like this - this is because split returns an array

instead of this

Dim varVariant As Variant

define as this

Dim varVariant() As string



alternative method

if instr(1,varFiles,";")>0 then
    varVariant = Split(varFiles, ";")
else
  varVariant = varFiles
end if

0
 
lightcrossAuthor Commented:
i made a mistake.  the program actually bombs at the import stage.  I dont know why it would though?  the variable varFiles is correct wether the user selects a single or multiple files??  

DoCmd.TransferText "transfertype" = "acImportDelimited", _
         specificationname:="DataImportVersion1 ", _
         TableName:="" & varRawTable, _
               Filename:=varFiles, _
               hasfieldnames:=False
0
 
rockiroadsCommented:
did u try what I suggested before?



also I dont think acImportDelimited has to be in double quotes,

have u tried manually importing the file ? hardcode the names in a test

have u confirmed all variables have a valid value?

try a debug/compile, does it hilite any thing
0
 
lightcrossAuthor Commented:
I did try your suggestions but it didnt change the results.  like i mentioned, it works perfect when the user selects multiple files.  if they choose one it doesnt work.  i msgbox the filename for a single selection and the path and filename are correct but it says "filename too long".  now if i select multiple it will have the same path but without error???
0
 
rockiroadsCommented:
I dont have the code handy for the api, but I will get it and test it
its quite late 4 me now, so I will get this fixed for you tomorrow
Im sure its trivial, it certainly looks it


varVariant = Split(varFiles, ";")


For varInt = LBound(varVariant) To UBound(varVariant)

 'What does this line do?
    varFiles = varVariant(varInt)


'Is this redudant code? ******
    s = Split(varFiles, "\")
        varImage = s(UBound(s))
       
       
    Fields = Split(varImage, ".")
        varFileName = Fields(0)
        varFileExtension = UCase(Fields(1))
        varFileRev = "1"
        'MsgBox "Processing - " & varFiles & ""
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TABLE - SWSRawUsername     ***** BEGIN


**** END OF REDUNDANT CODE? *****

Dim varRawTable As String
varRawTable = "SWSRaw-" & CurrentUser()

'checks if table exists in db, if it does it will be deleted
If acbDoesObjExist("" & varRawTable, acTable) Then
  DoCmd.DeleteObject acTable, "SWSRaw-" & CurrentUser()
End If
MsgBox varFiles
DoCmd.TransferText "transfertype" = acImportDelimited, _
         specificationname:="DataImportVersion1", _
         TableName:="" & varRawTable, _
               Filename:=varFiles, _
               hasfieldnames:=False

Next varInt





try using varVariant(varInt) as the filename instead of varFiles

0
 
lightcrossAuthor Commented:
TRIVIAL INDEED!!!

I hardcoded a filename in the transfertext code and it works fine.  man, this is bugging me and its critical to complete.  Thanks for your help, I will be anxious to see what you can help with tomorrow.

Here is the code I have trimmed it down to in order to avoid confusion as to whats going on.  

Private Sub cmdImportData_Click()

'BROWSE AND SELECT FILE FOR LOAD/IMPORT     ***** BEGIN
    'related variables
Dim strFilter As String
Dim lngFlags As Long
Dim varFiles As String
Dim lFlags As Long
Dim varVariant As Variant
Dim varInt As Integer
Dim sFilter As String
Dim s() As String
Dim varImage As String
Dim Fields
Dim varFileName As String
Dim varFileExtension As String
Dim varFileRev As String
Dim varItm As Variant

lFlags = ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER

   strFilter = ahtAddFilterItem(strFilter, "Raw Data Testing Files(*.txt)", _
                   "*.TXT")
varFiles = ahtCommonMultiFileOpenSave(InitialDir:=sFilter, _
                filter:=strFilter, FilterIndex:=1, flags:=lFlags, _
                DialogTitle:="Select File(s)")

If varFiles = "" Or varFiles = "NoFile" Then      'checks if user hits cancel in dialog box
    GoTo CancelSelected
End If

varVariant = Split(varFiles, ";")
 

For varInt = LBound(varVariant) To UBound(varVariant)

            varFiles = varVariant(varInt)   ' sets the  variable to the current variable in the array.  but you are right i dont need it i can use your
                                                         'suggestion and just use this varVariant(varInt)

        'MsgBox "Processing - " & varFiles & ""  ' just to help me see if the correct file is being processed
       
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TABLE - SWSRawUsername     ***** BEGIN
Dim varRawTable As String
varRawTable = "SWSRaw-" & CurrentUser()

'checks if table exists in db, if it does it will be deleted
If acbDoesObjExist("" & varRawTable, acTable) Then
DoCmd.DeleteObject acTable, "SWSRaw-" & CurrentUser()
End If

DoCmd.TransferText "transfertype" = "acImportDelimited", _
         specificationname:="DataImportVersion1 ", _
         TableName:="" & varRawTable, _
               Filename:=varVariant(varInt), _
               hasfieldnames:=False
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TABLE - SWSRawUsername     ***** END

'next i run some analysis on the imported data...

Next varInt
end sub
0
 
lightcrossAuthor Commented:
You know something I just noticed.  when it reports the error it says:
filename " is too long.

i think somehow " is creating the problem.  instead of using the correct variable it is getting " from somewhere????
0
 
lightcrossAuthor Commented:
just so you know i fixed the problem.  for whatever reason, access decided that it would be a good idea to add tons of non-text square box characters after the filename/path.  it only decides to do this when one file is selected for reasons unknown to me.  so i decided i would trim the filepath variable regardless if one or multiple files are selected.

this line does the trick:

Dim charCount As Integer
      charCount = InStr(varFiles, ".")
      varFiles = Left(varFiles, (charCount + 3))
Thanks for your help!

Vic
0
 
lightcrossAuthor Commented:
i will post another question with link for you so you can earn some points for your effort.  fair?  
0
 
rockiroadsCommented:
Hi lightcross - well done!
u can reassign points, grade different levels etc or just raise a question in community support to close this as you have solved it. Either way, Im not fussed so I wont take offence is what u decide to do.

Pity I didnt have the api call code so help you quicker

0
 
lightcrossAuthor Commented:
no problem.  hey, if you can tell me why its adding the boxes to the end of the string by tomorrow morning I can still award full points!  i only see it when i am vb using break points and "watching" the variable.  if i msgbox the variable name it displays it with the strange characters.
0
 
rockiroadsCommented:
no probs, I had better get the code to ahtCommonDialog then, I dont have it at the moment
0
 
rockiroadsCommented:
Ive got the code, will try later

0
 
rockiroadsCommented:
in ahtCommonMultiDialog
does it perform a TrimNull on the result?

there should be a function called TrimNull



If not, what u can do is run TrimNull on the result

Private Function TrimNull(ByVal strItem As String) As String
    Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
        TrimNull = Left(strItem, intPos - 1)
    Else
        TrimNull = strItem
    End If
End Function


also, u have a deleteobject

If acbDoesObjExist("" & varRawTable, acTable) Then
    DoCmd.DeleteObject acTable, "SWSRaw-" & CurrentUser()
End

This is inside the loop, is that what u wanted? it looks like u delete the table before the import
if u do it twice u will only ever get the last import

0
 
rockiroadsCommented:
ok, the  code lets me select multiple files but does not process them correctly
as I always only ever get one file back
could you post your ahtCommonMultiDialog function pls
0
 
lightcrossAuthor Commented:
'here is my multi-select file open/save dialog box code.  i forgot where i got it from so if someone else uses it sorry for not giving the creator props.  I did not modify this code in any way.  i

Function ahtCommonMultiFileOpenSave( _
            Optional ByRef flags As Variant, _
            Optional ByVal InitialDir As Variant, _
            Optional ByVal filter As Variant, _
            Optional ByVal FilterIndex As Variant, _
            Optional ByVal DefaultExt As Variant, _
            Optional ByVal Filename As Variant, _
            Optional ByVal DialogTitle As Variant, _
            Optional ByVal hWnd As Variant, _
            Optional ByVal OpenFile As Variant) As Variant

    Dim OFN As tagOPENFILENAME
    Dim strFileName As String
    Dim strFileTitle As String
    Dim fResult As Boolean
    Dim sFiles() As String
    Dim I As Integer
    Dim sSelectedItem As String
    Dim sDrive As String


    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(filter) Then filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(flags) Then flags = 0&
    If IsMissing(DefaultExt) Then DefaultExt = ""
    If IsMissing(Filename) Then Filename = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hWnd) Then hWnd = Application.hWndAccessApp
    If IsMissing(OpenFile) Then OpenFile = True
   
    ' Allocate string space for the returned strings.
    strFileName = Left(Filename & String(6000, 0), 6000)
    strFileTitle = String(6000, 0)
   
    ' Set up the data structure before you call the function
    With OFN
        .lStructSize = Len(OFN)
        .hwndOwner = hWnd
        .strFilter = filter
        .nFilterIndex = FilterIndex
        .strFile = strFileName
        .nMaxFile = Len(strFileName)
        .strFileTitle = strFileTitle
        .nMaxFileTitle = Len(strFileTitle)
        .strTitle = DialogTitle
        .flags = flags
        .strDefExt = DefaultExt
        .strInitialDir = InitialDir
        ' Didn't think most people would want to deal with
        ' these options.
        .hInstance = 0
        .strCustomFilter = ""
        .nMaxCustFilter = 0
        .lpfnHook = 0
        'New for NT 4.0
        .strCustomFilter = String(255, 0)
        .nMaxCustFilter = 255
    End With

    ' This will pass the desired data structure to the
    ' Windows API, which will in turn it uses to display
    ' the Open/Save As Dialog.
    If OpenFile Then
        fResult = aht_apiGetOpenFileName(OFN)
    Else
        fResult = aht_apiGetSaveFileName(OFN)
    End If

    ' The function call filled in the strFileTitle member
    ' of the structure. You'll have to write special code
    ' to retrieve that if you're interested.
    If fResult Then
        ' You might care to check the Flags member of the
        ' structure to get information about the chosen file.
        ' In this example, if you bothered to pass in a
        ' value for Flags, we'll fill it in with the outgoing
        ' Flags value.
        If Not IsMissing(flags) Then flags = OFN.flags
       
       
        sSelectedItem = Replace(OFN.strFile, vbNullChar, ";")
        Debug.Print OFN.strFile
        sFiles = Split(sSelectedItem, ";")
       
        'Check network path
        If Left(sFiles(0), 2) = "\\" Then
           
            If GetAttr(sFiles(0)) And vbDirectory = True Then
                ahtCommonMultiFileOpenSave = sFiles(0)
                Exit Function
            End If
       
        'Just double check, If not drive then assume just one entry selected
        'This is Stupid why assum 1 file when local always alow Multi file it works with 1  also
       End If
       'If Left(sFiles(0), 2) <> ":\" Then
          '  ahtCommonMultiFileOpenSave = sFiles(0)
          '  Exit Function
        'End If
       
        ahtCommonMultiFileOpenSave = ""
       
        'When splitting the first has got to be a drive letter
        'Stik \ on end
        sDrive = sFiles(0)
        If Right$(sDrive, 1) <> "\" Then sDrive = sDrive & "\"
       
        'Now go thru list of files, adding drive letter to each file
        For I = LBound(sFiles) + 1 To UBound(sFiles)
            If sFiles(I) <> vbNullChar And Trim$(sFiles(I)) <> "" Then
                If ahtCommonMultiFileOpenSave <> "" Then ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & ";"
                ahtCommonMultiFileOpenSave = ahtCommonMultiFileOpenSave & sDrive & sFiles(I)
            End If
        Next I
       
        If ahtCommonMultiFileOpenSave = "" And OFN.strFile <> "" Then ahtCommonMultiFileOpenSave = OFN.strFile
    Else
        ahtCommonMultiFileOpenSave = "NoFile"
    End If
End Function

'***********************************************************************************************
'       here is my code that previously had issues

Private Sub cmdImportData_Click()

'BROWSE AND SELECT FILE FOR LOAD/IMPORT     ***** BEGIN
    'related variables
Dim strFilter As String
Dim lngFlags As Long
Dim varFiles As String
Dim varVariant As Variant
Dim varInt As Integer
Dim sFilter As String
Dim s() As String
Dim varImage As String
Dim Fields
Dim varFileName As String
Dim varFileExtension As String
Dim varFileRev As String
Dim varItm As Variant

    'On Error GoTo CancelSelected

' strFilter filters files in dialog box used in procedure call as variable
 strFilter = ahtAddFilterItem(strFilter, "Raw Data Testing Files(*.txt)", _
                   "*.TXT")
varFiles = ahtCommonMultiFileOpenSave(InitialDir:=sFilter, _
                filter:=strFilter, FilterIndex:=1, flags:=ahtOFN_ALLOWMULTISELECT Or ahtOFN_EXPLORER, _
                DialogTitle:="Select File(s)")

If varFiles = "" Or varFiles = "NoFile" Then
    GoTo CancelSelected
End If


'dialog box returns a string with filepath seperated by ;  I split string here
varVariant = Split(varFiles, ";")
 
'here i process each filepath from the split
For varInt = LBound(varVariant) To UBound(varVariant)
    varFiles = varVariant(varInt)

'this code was needed to trim my string.  for odd reasons ascii square characters were being added when only 1 file was selected.
    Dim charCount As Integer
      charCount = InStr(varFiles, ".")
      varFiles = Left(varFiles, (charCount + 3))
     
       
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TEMP TABLE - SWSRawUsername     ***** BEGIN
Dim varRawTable As String
varRawTable = "SWSRaw-" & CurrentUser()

'checks if table exists in db, if it does it will be deleted
If acbDoesObjExist("" & varRawTable, acTable) Then
DoCmd.DeleteObject acTable, "SWSRaw-" & CurrentUser()
End If

DoCmd.TransferText "transfertype" = "acImportDelimited", _
         specificationname:="DataImportVersion1 ", _
         TableName:="" & varRawTable, _
               Filename:=varFiles, _
               hasfieldnames:=False
'TRANSFERS RAW DATA TEXT FILE INTO DATABASE AS A TEMP TABLE - SWSRawUsername     ***** END

'code removed here.  basically processes temp raw data table for information and stores only needed data in another table.
'on the next pass within this loop the temp table is deleted in order to process next file

Next varInt
End sub


0
 
lightcrossAuthor Commented:
Im sorry, I dont get what you are saying.  I see that the trim null is function exists in my code already.  probably from way back when I initially added the select dialog thing.  

anyhow, I have already come into problems with my code when the user has a "." in a directory name.  

Looks like I am going to have to use your suggestions but I am not clear what you are saying or where to stick your code mod in.

thanks again!
0
 
lightcrossAuthor Commented:
ahh.. nevermind.  I gotcha.  hey, its okay that i made my previous trimnull private function a new module and as a public function correct?  thanks for this correction.  this is definately the proper fix vs. the way I was trying to trim it up!

0
 
rockiroadsCommented:
Alright lightcross, is it working now?
Not sure if your sorted now or not
Do u still have a problem with "." in the directory name
0
 
lightcrossAuthor Commented:
No, its working perfect now.  the trimnull fixed it.  thanks again.
0
 
rockiroadsCommented:
ok, cool
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.