Move file to new dir (almost there :s)

[vinzz]

Hi,

I'm trying to move all my files (4008 files/1 dir) to move to different dirs.

i've made a function out of some examples on this board. But without success.

here's my code, i hope someone find the fault.

Public Function Movingdir()

Dim objdir As Object, objfiles As Object, objfile As Object
Dim strNewName As String
Dim newmapp As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set objdir = fso.GetFolder("K:\opslagword\")

Set objfiles = objdir.files
For Each objfile In objfiles
dirmap = objdir.Path
bestandnaam = Left(objfile.Name, 20)
    
    newmapp = objdir.Path & "\" & bestandnaam & "\" & objfile.Name
    If Len(Dir(dirmap & "\" & bestandnaam, vbDirectory)) = 0 Then
    MkDir dirmap & "\" & bestandnaam
    End If
    
    strNewName = Replace(objfile, "", newmapp)
  
  objfile.Move (strNewName)
Next
End Function

atm it gives a fault at " file.Move (strNewName)" so i think there is a fault in my StrNewName. But i have no idea what... :S

 

[vinzz]

nvm, found it:

Public Function Movingdir()
Dim fso
Dim objdir As Object, objfiles As Object, objfile As Object
Dim strNewName As String
Dim newmapp As String

Set fso = CreateObject("Scripting.FileSystemObject")
Set objdir = fso.GetFolder("K:\opslagword\")

Set objfiles = objdir.files
For Each objfile In objfiles
dirmap = objdir.Path
bestandnaam = Left(objfile.Name, 20)
    
    newmapp = objdir.Path & "\" & bestandnaam & "\" & objfile.Name
    If Len(Dir(dirmap & "\" & bestandnaam, vbDirectory)) = 0 Then
    MkDir dirmap & "\" & bestandnaam
    End If
      
  fso.Movefile objfile, newmapp
  
Next
End Function