Dim fso, fldr, day, month, year, directory, ofiles,ofldr,extension

'-----------------
On Error Resume Next

SourcePath   	= WScript.Arguments(0)
ArchivePath  	= WScript.Arguments(1)
WildCard     	= WScript.Arguments(2)

Main Sourcepath, ArchivePath, WildCard

Sub Main (ByVal SourcePath, ByVal ArchivePath, ByVal WildCard)

   If WScript.Arguments.Count <> 3 then
      WScript.Echo "Invalid number of arguments."
      Exit Sub
   End If

   If NOT (Right(SourcePath,1) = "\") then
      WScript.Echo "Source Path must end in a slash."
      Exit Sub
   End If

   If NOT (Right(ArchivePath,1) = "\") then
      WScript.Echo "Archive Path must end in a slash."
      Exit Sub
   End If

    Dim Path
    Path = SourcePath & WildCard
'   Path = "e:\outgoingfeeds\fbs*.txt"

   Dim a: a = ListDir(Path)


   day = Right("00" & DatePart("d",Date()),2)
   month = Right("00" & DatePart("m",Date()),2)
   year = DatePart("yyyy",Date())

   directory = month & day & year

   Set fso = CreateObject("Scripting.FileSystemObject")
   directory = ArchivePath & directory & "\"
   On Error Resume Next
   set fldr = fso.getFolder(directory)
   If Err.Number <> 0 Then
	set fldr = Nothing
	Set fldr = fso.CreateFolder(directory)
   End If

   If UBound(a) = -1 then
      WScript.Echo "No files found."
      Exit Sub
      End If
   Dim FileName
   Set fso = CreateObject("Scripting.FileSystemObject")

   For Each FileName In a
      WScript.Echo FileName
      fso.MoveFile FileName, directory
   Next

   set oFSO = Nothing
   set oFldr = Nothing
   set oFiles = Nothing

End Sub
'-----------------
' Returns an array with the file names that match Path.
' The Path string may contain the wildcard characters "*"
' and "?" in the file name component. The same rules apply
' as with the MSDOS DIR command.
' If Path is a directory, the contents of this directory is listed.
' If Path is empty, the current directory is listed.
' Author: Christian d'Heureuse (www.source-code.biz)
Public Function ListDir (ByVal Path)
   Dim fso: Set fso = CreateObject("Scripting.FileSystemObject")
   If Path = "" then Path = "*.*"
   Dim Parent, Filter
   if fso.FolderExists(Path) then      ' Path is a directory
      Parent = Path
      Filter = "*"
     Else
      Parent = fso.GetParentFolderName(Path)
      If Parent = "" Then If Right(Path,1) = ":" Then Parent = Path: Else Parent = "."
      Filter = fso.GetFileName(Path)
      If Filter = "" Then Filter = "*"
      End If
   ReDim a(10)
   Dim n: n = 0
   Dim Folder: Set Folder = fso.GetFolder(Parent)
   Dim Files: Set Files = Folder.Files
   Dim File
   For Each File In Files
      If CompareFileName(File.Name,Filter) Then
         If n > UBound(a) Then ReDim Preserve a(n*2)
         a(n) = File.Path
         n = n + 1
         End If
      Next
   ReDim Preserve a(n-1)
   ListDir = a
   End Function

Private Function CompareFileName (ByVal Name, ByVal Filter) ' (recursive)
   CompareFileName = False
   Dim np, fp: np = 1: fp = 1
   Do
      If fp > Len(Filter) Then CompareFileName = np > len(name): Exit Function
      If Mid(Filter,fp) = ".*" Then    ' special case: ".*" at end of filter
         If np > Len(Name) Then CompareFileName = True: Exit Function
         End If
      If Mid(Filter,fp) = "." Then     ' special case: "." at end of filter
         CompareFileName = np > Len(Name): Exit Function
         End If
      Dim fc: fc = Mid(Filter,fp,1): fp = fp + 1
      Select Case fc
         Case "*"
            CompareFileName = CompareFileName2(name,np,filter,fp)
            Exit Function
         Case "?"
            If np <= Len(Name) And Mid(Name,np,1) <> "." Then np = np + 1
         Case Else
            If np > Len(Name) Then Exit Function
            Dim nc: nc = Mid(Name,np,1): np = np + 1
            If Strcomp(fc,nc,vbTextCompare)<>0 Then Exit Function
         End Select
      Loop
   End Function

Private Function CompareFileName2 (ByVal Name, ByVal np0, ByVal Filter, ByVal fp0)
   Dim fp: fp = fp0
   Dim fc2
   Do                                  ' skip over "*" and "?" characters in filter
      If fp > Len(Filter) Then CompareFileName2 = True: Exit Function
      fc2 = Mid(Filter,fp,1): fp = fp + 1
      If fc2 <> "*" And fc2 <> "?" Then Exit Do
      Loop
   If fc2 = "." Then
      If Mid(Filter,fp) = "*" Then     ' special case: ".*" at end of filter
         CompareFileName2 = True: Exit Function
         End If
      If fp > Len(Filter) Then         ' special case: "." at end of filter
         CompareFileName2 = InStr(np0,Name,".") = 0: Exit Function
         End If
      End If
   Dim np
   For np = np0 To Len(Name)
      Dim nc: nc = Mid(Name,np,1)
      If StrComp(fc2,nc,vbTextCompare)=0 Then
         If CompareFileName(Mid(Name,np+1),Mid(Filter,fp)) Then
            CompareFileName2 = True: Exit Function
            End If
         End If
      Next
   CompareFileName2 = False
   End Function