FileSystemObject error when the file names has special letters

[Dreamweaver]

Thanks @MajP didn't know that

 

[MajP]

Here it is with late binding

Dim FSO As object
Dim objFolder As Object
Dim objFile As object
Dim OldName As String
Dim NewName As String
Dim FolderPath As String
Dim I As Integer
Dim j As Integer
Set FSO = CreateObject("Scripting.FileSystemObject")

On Error GoTo errlog
'modify your path
FolderPath = CurrentProject.Path & "\" & "Sample CSV Files"
Set objFolder = FSO.GetFolder(FolderPath)
For Each objFile In objFolder.Files

  If Right(objFile.Name, 3) = "csv" Then
    OldName = objFile.Name
    j = j + 1
    NewName = "Import_" & Format(Date, "yyyymmdd") & "_" & j & ".csv"
   'Debug.Print OldName & " " & NewName
    'Choose to copy
    FSO.CopyFile FolderPath & "\" & OldName, FolderPath & "\" & NewName
    'Or choose to rename
    'FSO.MoveFile FolderPath & "\" & OldName, FolderPath & "\" & NewName
    DoCmd.TransferText acImportDelim, "MB3", "MB_Sheet_Ham", FolderPath & "\" & NewName, False
    FSO.DeleteFile FolderPath & "\" & NewName
  End If
Next objFile
Exit Sub
errlog:
  Debug.Print Err.Number & " " & Err.Description & " new name: " & NewName
  Resume Next
Set objFile = Nothing
Set objFolder = Nothing
Set FSO = Nothing
End Sub

 

[Dreamweaver]

That I can read Lol

 

[MajP]

@MajP - UNICODE simply has a way to map more than 256 characters. It is not uniform, however. Technically, UCS-2, UTF-8, UTF-16, and several other extensions are all UNICODE. I can explain it but this article probably does it better.

Unicode - Wikipedia

en.wikipedia.org

The SHORT answer is that you need to know two things to identify a character - (a) which scheme you are using and (b) the character and the byte or bytes that follow it.

My take away is that windows allows extended unicode file names, but VBA file commands cannot handle beyond standard ASCII set.

 

[Dreamweaver]

Now I think Of it Onedrive had an issue with a folder name created buy my program the only thing I could see was a character that my program didn't have in it's replace list, it had to change it for an _

 

[Ocicek]

It is correct. For debugging purposes I did early binding and added a reference to FSO. You can turn that all back to Object.

I did but now I got a "New FileSystemObject" definition error.

 

[Ocicek]

Like this.

 

[MajP]

You left in the line
Set FSO = new filessystemobject
please delete

 

[Ocicek]

You left in the line
Set FSO = new filessystemobject
please delete

Finally worked

Thank you very much !

 

[MajP]

@Ocicek,
If not familiar this may be of interest.

Early and Late Binding - Visual Basic

Learn more about: Early and Late Binding (Visual Basic)

docs.microsoft.com

I changed to early binding so that I could use intellisense to get the properties and methods. I forgot to remove it or instruct you to add the Reference to Microsoft Scripting Runtime.
Most people develop with early binding and then change to late binding if distributing to other people.

 

[MajP]

Finally worked

Thank you very much !

No problem. This is one of those good posts where I learn more from answering than the OP.

 

[Isaac]

This thread, and the fact that it is placed in the 'visual basic' forum, reminds me of a time that a person (more skilled than I in .Net generally) saw one of my SSIS packages with a Script Task. Talk about being critiqued, but I had it coming. They started with the use of vb.net instead of c#.net. Then when they got to me using Scripting.Filesystemobject......Uhh. It was just a bad meeting. I'm glad it wasn't in person. I was embarrassed.

 

[Ocicek]

No problem. This is one of those good posts where I learn more from answering than the OP.

Dear MajP we are on good way to calculate more than thousands meter values and billing process on our accdb.

On this thread you know we were choosing the folder and importing the csv files in to our access table.

I would like to make it more flexible due to our requirements. So is it possible to pick multiple files from file dialog?

 

[MajP]

Yes. I am not at my computer but in fact it always returns a collection of names.

 

[MajP]

Here is one module with the different methods. Choose by folder or choose multiselect

Public Function GetFileDialog() As String
 
   ' Requires reference to Microsoft Office 11.0 Object Library.
 
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
  
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
 
   With fDialog
 
      ' Allow user to make multiple selections in dialog box
      .AllowMultiSelect = False
      ' Set the title of the dialog box.
      .Title = "Please select Backend Database"
 
      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "MP3", "*.mp3"
    
      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
 
         'Loop through each file selected and add it to our list box.
        GetFileDialog = .SelectedItems(1)
        ' For Each varFile In .SelectedItems
        '    GetFileDialog = varFile
        ' Next
 
      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Function
Public Function GetFileDialog_Files() As Collection
 
   ' Requires reference to Microsoft Office 11.0 Object Library.
 
   Dim fDialog As Office.FileDialog
   Dim varFile As Variant
   Dim col As New Collection
   Dim i As Integer
   ' Set up the File Dialog.
   Set fDialog = Application.FileDialog(msoFileDialogFilePicker)
 
   With fDialog
 
      ' Allow user to make multiple selections in dialog box
      .AllowMultiSelect = True
      ' Set the title of the dialog box.
      .Title = "Please select Backend Database"
 
      ' Clear out the current filters, and add our own.
      .Filters.Clear
      .Filters.Add "CSV", "*.csv"
    
      ' Show the dialog box. If the .Show method returns True, the
      ' user picked at least one file. If the .Show method returns
      ' False, the user clicked Cancel.
      If .Show = True Then
        MsgBox fDialog.SelectedItems.Count
         'Loop through each file selected and add it to our list box.
        For i = 1 To fDialog.SelectedItems.Count
          col.Add fDialog.SelectedItems(i)
        Next i
        Set GetFileDialog_Files = col
        ' For Each varFile In .SelectedItems
        '    GetFileDialog = varFile
        ' Next
 
      Else
         MsgBox "You clicked Cancel in the file dialog box."
      End If
   End With
End Function

Public Function GetFolderDialog() As String
    Dim sFolder As String
    ' Open the select folder prompt
    With Application.FileDialog(msoFileDialogFolderPicker)
        If .Show = -1 Then ' if OK is pressed
            sFolder = .SelectedItems(1)
        End If
    End With
    GetFolderDialog = sFolder
End Function


Public Sub RenameFilesAndImportFolder()

Dim fso As FileSystemObject
Dim objFolder As Object
Dim objFile As Scripting.File
Dim OldName As String
Dim NewName As String
Dim FolderPath As String
Dim i As Integer

Set fso = CreateObject("Scripting.FileSystemObject")

Set fso = New FileSystemObject
'Set objFile = New Scripting.File
On Error GoTo errlog
'Assumes forlder of CSV Files
FolderPath = GetFolderDialog
FolderPath = CurrentProject.Path & "\" & "Sample CSV Files"
Set objFolder = fso.GetFolder(FolderPath)
For Each objFile In objFolder.files
 
  If Right(objFile.Name, 3) = "csv" Then
    OldName = objFile.Name
   ' NewName = ReplaceInternationalCharacters(objFile.Name)
    NewName = ReplaceUnicode(NewName)
   ' For I = 1 To Len(NewName)
   '   Debug.Print (Mid(NewName, I, 1)) & " " & Asc(Mid(NewName, I, 1))
   ' Next I
    Debug.Print OldName & " " & NewName
    Debug.Print
    fso.MoveFile FolderPath & "\" & OldName, FolderPath & "\" & NewName
    DoCmd.TransferText acImportDelim, "MB3", "MB_Sheet_Ham", FolderPath & "\" & NewName, False
  End If
Next objFile
Exit Sub
errlog:
  Debug.Print Err.Number & " " & Err.Description & " new name: " & NewName
  Resume Next
Set objFile = Nothing
Set objFolder = Nothing
Set fso = Nothing
End Sub

Public Sub RenameFilesAndImportMultiFiles()

Dim fso As FileSystemObject
'objFolder As Object
Dim SelectedFiles As Collection
Dim objFile As Scripting.File
Dim OldName As String
Dim NewName As String
Dim FolderPath As String
Dim i As Integer
Dim files As New Collection
Set fso = CreateObject("Scripting.FileSystemObject")

Set fso = New FileSystemObject
'On Error GoTo errlog

Set SelectedFiles = GetFileDialog_Files
For i = 1 To SelectedFiles.Count
  Set objFile = fso.GetFile(SelectedFiles(i))
  If Right(objFile.Name, 3) = "csv" Then
    OldName = objFile.Name
    NewName = ReplaceBadCharacters(OldName)
     Debug.Print OldName & " " & NewName
    Debug.Print
    fso.MoveFile OldName, NewName
    'DoCmd.TransferText acImportDelim, "MB3", "MB_Sheet_Ham", FolderPath & "\" & NewName, False
  End If
Next i
 
 

Exit Sub
errlog:
  Debug.Print Err.Number & " " & Err.Description & " new name: " & NewName
  Resume Next
Set objFile = Nothing
Set fso = Nothing
End Sub

 

[MajP]

Here is the code for cleaning. It may go beyond what needs to be replaced, but does not matter in your case.

Option Compare Database
Option Explicit

Private Function InternationalCharacters(ByVal strText As String) As String
   InternationalCharacters = strText
   'If you type international characters then turn them first to english
    'Type international and get english Add others as necessary á, é, í, ó, ú, ü, ñ
    'I do not know which ones are supported by keyboards but you may have to include
    'all seen below
    InternationalCharacters = Replace(InternationalCharacters, "á", "a")
    InternationalCharacters = Replace(InternationalCharacters, "é", "e")
    InternationalCharacters = Replace(InternationalCharacters, "í", "i")
    InternationalCharacters = Replace(InternationalCharacters, "ó", "o")
    InternationalCharacters = Replace(InternationalCharacters, "ú", "u")
    InternationalCharacters = Replace(InternationalCharacters, "ü", "u")
    InternationalCharacters = Replace(InternationalCharacters, "ñ", "n")
        

   'Type english and get international
    InternationalCharacters = Replace(InternationalCharacters, "a", "[aàáâãäå]")
    InternationalCharacters = Replace(InternationalCharacters, "e", "[eèéêë]")
    InternationalCharacters = Replace(InternationalCharacters, "i", "[iìíîï]")
    InternationalCharacters = Replace(InternationalCharacters, "o", "[oòóôõöø]")
    InternationalCharacters = Replace(InternationalCharacters, "u", "[uùúûü]")
    InternationalCharacters = Replace(InternationalCharacters, "n", "[nñ]")
    InternationalCharacters = Replace(InternationalCharacters, "y", "[yýÿ]")
    InternationalCharacters = Replace(InternationalCharacters, "z", "[zž]")
    InternationalCharacters = Replace(InternationalCharacters, "s", "[sš]")
    InternationalCharacters = Replace(InternationalCharacters, "d", "[dð]")
 
End Function
Public Function ReplaceInternationalCharacters(ByVal strText As String) As String
    
    Dim i As Integer
    'Big A
    For i = 192 To 197
            ReplaceInternationalCharacters = Replace(strText, Chr(i), "A")
    Next i
    'little A
     For i = 224 To 229
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "a")
    Next i
    'Big E
     For i = 200 To 203
            ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "E")
    Next i
    'little e
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(130), "e")
     For i = 232 To 235
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), Chr(101))
    Next i
    'Big I
    For i = 204 To 207
            ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "I")
    Next i
    'little i
     For i = 236 To 239
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "i")
    Next i
    'Replace Big O
    For i = 210 To 214
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "O")
    Next i
    'Replace little o
    For i = 242 To 248
      ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "o")
    Next i

    'Replace Big U
    For i = 217 To 220
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "U")
    Next i
    'Replace little u
    For i = 249 To 252
      ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "u")
    Next i

    'Replace Big Y
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(152), "y")
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(236), "y")
    'Replace Big N
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(209), "N")
    'Replace little N
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(241), "n")
    End Function
Public Function ReplaceSpecialCharacters(ByVal strText As String, Optional ReplaceChar As String = "_")
   Dim i As Integer
   ReplaceSpecialCharacters = strText
   'Need to make a decision if you want to replace ' with '' or get rid of it.
   'Depends on how you want to use it
   ReplaceSpecialCharacters = Replace(ReplaceSpecialCharacters, "'", "")
   ReplaceSpecialCharacters = Replace(ReplaceSpecialCharacters, "#", "_No_")
End Function

'Public Function ReplaceUnicodeCharacters(txt As String) As String
'    Dim regEx As Object
'    Set regEx = CreateObject("vbscript.regexp")
'    regEx.Pattern = "[^\u0000-\u007F]"
'    ReplaceUnicodeCharacters = regEx.Replace(txt, "~")
'End Function
Public Function ReplaceUnicodeCharacters(txt As String) As String
  Dim i As Integer
  Dim out As String
  For i = 1 To Len(txt)
    If AscW(Mid(txt, i, 1)) < 256 And AscW(Mid(txt, i, 1)) > 31 Then
      out = out & Mid(txt, i, 1)
     End If
  Next i
  ReplaceUnicodeCharacters = out
End Function

Public Function ReplaceBadCharacters(ByVal strTxt As String) As String
   ReplaceBadCharacters = strTxt
   ReplaceBadCharacters = ReplaceInternationalCharacters(ReplaceBadCharacters)
   ReplaceBadCharacters = ReplaceSpecialCharacters(ReplaceBadCharacters)
   ReplaceBadCharacters = ReplaceUnicodeCharacters(ReplaceBadCharacters)
End Function

 

[MajP]

Also for test purposes (I do not know the FSO methods and properties by memorization) I did some early binding. You may want to go back to late. But you will need the reference to Microsoft Scripting Runtime if not.

 

[Ocicek]

Thank you dear MajP I'm also not at computer. I'll check that on first chance.

 

[vhung]

Here is the code for cleaning. It may go beyond what needs to be replaced, but does not matter in your case.

Option Compare Database
Option Explicit

Private Function InternationalCharacters(ByVal strText As String) As String
   InternationalCharacters = strText
   'If you type international characters then turn them first to english
    'Type international and get english Add others as necessary á, é, í, ó, ú, ü, ñ
    'I do not know which ones are supported by keyboards but you may have to include
    'all seen below
    InternationalCharacters = Replace(InternationalCharacters, "á", "a")
    InternationalCharacters = Replace(InternationalCharacters, "é", "e")
    InternationalCharacters = Replace(InternationalCharacters, "í", "i")
    InternationalCharacters = Replace(InternationalCharacters, "ó", "o")
    InternationalCharacters = Replace(InternationalCharacters, "ú", "u")
    InternationalCharacters = Replace(InternationalCharacters, "ü", "u")
    InternationalCharacters = Replace(InternationalCharacters, "ñ", "n")
        

   'Type english and get international
    InternationalCharacters = Replace(InternationalCharacters, "a", "[aàáâãäå]")
    InternationalCharacters = Replace(InternationalCharacters, "e", "[eèéêë]")
    InternationalCharacters = Replace(InternationalCharacters, "i", "[iìíîï]")
    InternationalCharacters = Replace(InternationalCharacters, "o", "[oòóôõöø]")
    InternationalCharacters = Replace(InternationalCharacters, "u", "[uùúûü]")
    InternationalCharacters = Replace(InternationalCharacters, "n", "[nñ]")
    InternationalCharacters = Replace(InternationalCharacters, "y", "[yýÿ]")
    InternationalCharacters = Replace(InternationalCharacters, "z", "[zž]")
    InternationalCharacters = Replace(InternationalCharacters, "s", "[sš]")
    InternationalCharacters = Replace(InternationalCharacters, "d", "[dð]")
 
End Function
Public Function ReplaceInternationalCharacters(ByVal strText As String) As String
    
    Dim i As Integer
    'Big A
    For i = 192 To 197
            ReplaceInternationalCharacters = Replace(strText, Chr(i), "A")
    Next i
    'little A
     For i = 224 To 229
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "a")
    Next i
    'Big E
     For i = 200 To 203
            ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "E")
    Next i
    'little e
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(130), "e")
     For i = 232 To 235
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), Chr(101))
    Next i
    'Big I
    For i = 204 To 207
            ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "I")
    Next i
    'little i
     For i = 236 To 239
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "i")
    Next i
    'Replace Big O
    For i = 210 To 214
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "O")
    Next i
    'Replace little o
    For i = 242 To 248
      ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "o")
    Next i

    'Replace Big U
    For i = 217 To 220
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "U")
    Next i
    'Replace little u
    For i = 249 To 252
      ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(i), "u")
    Next i

    'Replace Big Y
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(152), "y")
       ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(236), "y")
    'Replace Big N
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(209), "N")
    'Replace little N
    ReplaceInternationalCharacters = Replace(ReplaceInternationalCharacters, Chr(241), "n")
    End Function
Public Function ReplaceSpecialCharacters(ByVal strText As String, Optional ReplaceChar As String = "_")
   Dim i As Integer
   ReplaceSpecialCharacters = strText
   'Need to make a decision if you want to replace ' with '' or get rid of it.
   'Depends on how you want to use it
   ReplaceSpecialCharacters = Replace(ReplaceSpecialCharacters, "'", "")
   ReplaceSpecialCharacters = Replace(ReplaceSpecialCharacters, "#", "_No_")
End Function

'Public Function ReplaceUnicodeCharacters(txt As String) As String
'    Dim regEx As Object
'    Set regEx = CreateObject("vbscript.regexp")
'    regEx.Pattern = "[^\u0000-\u007F]"
'    ReplaceUnicodeCharacters = regEx.Replace(txt, "~")
'End Function
Public Function ReplaceUnicodeCharacters(txt As String) As String
  Dim i As Integer
  Dim out As String
  For i = 1 To Len(txt)
    If AscW(Mid(txt, i, 1)) < 256 And AscW(Mid(txt, i, 1)) > 31 Then
      out = out & Mid(txt, i, 1)
     End If
  Next i
  ReplaceUnicodeCharacters = out
End Function

Public Function ReplaceBadCharacters(ByVal strTxt As String) As String
   ReplaceBadCharacters = strTxt
   ReplaceBadCharacters = ReplaceInternationalCharacters(ReplaceBadCharacters)
   ReplaceBadCharacters = ReplaceSpecialCharacters(ReplaceBadCharacters)
   ReplaceBadCharacters = ReplaceUnicodeCharacters(ReplaceBadCharacters)
End Function

Could this be?
if InternationalCharacters = "a" then: InternationalCharacters = Replace(InternationalCharacters, "a", "[aàáâãäå]")

 

[MajP]

Yes