I am almost finished

need to create folder tho


Sub Test1()
'
' Test1 Makro
'

Dim StrOldPath As String, StrNewPath As String
StrOldPath = ActiveDocument.Path
StrNewPath = Left(StrOldPath, InStrRev(StrOldPath, "\"))
StrOldPath = StrOldPath & "\"


FileExt = "*.pdf*" '<< Change
'You can use *.* for all files or *.doc for Word files

If Right(StrOldPath, 1) <> "\" Then
StrOldPath = StrOldPath & "\"
End If

Set FSO = CreateObject("scripting.filesystemobject")

If FSO.FolderExists(StrOldPath) = False Then
MsgBox StrOldPath & " doesn't exist"
Exit Sub
End If

If FSO.FolderExists(StrNewPath) = False Then
MsgBox ToPath & " doesn't exist"
Exit Sub
End If

FSO.CopyFile Source:=StrOldPath & FileExt, Destination:=StrNewPath
MsgBox "You can find the files from " & StrOldPath & " in " & StrNewPath


End Sub