Private Sub ImportApp_Click()
On Error GoTo ErrorHandle
Dim fso
Dim fco
Dim sfol As String, dfol As String, fnow As String
Set fco = CreateObject("Scripting.FileSystemObject")
fnow = (Format(Now(), "ddmmyy-hhmmss-AM/PM"))
Application.ImportXML "C:\Sample\Sample.xml", acAppendData

sfol = "C:\TempFolder"
dfol = "C:\Archive\" & fnow & ""

If Not fco.FolderExists(dfol) Then
    fco.CreateFolder (dfol)

Set fso = CreateObject("Scripting.FileSystemObject")


Name "C:\TempFolder\Sample.xml" As (dfol)

If Not fso.FolderExists(sfol) Then
    MsgBox sfol & " is not a valid folder/path.", vbInformation, "Invalid Source"
ElseIf Not fso.FolderExists(dfol) Then
    MsgBox dfol & " is not a valid folder/path.", vbInformation, "Invalid Destination"
Else
On Error Resume Next
    fso.MoveFile (sfol & "\*.pdf"), dfol
    fso.MoveFile (sfol & "\*.mht"), dfol
    fso.MoveFile (sfol & "\*.doc"), dfol
    fso.MoveFile (sfol & "\*.jpg"), dfol
    fso.MoveFile (sfol & "\*.tiff"), dfol
End If

Exit_ImportApp_Click:
Exit Sub
ErrorHandle:

Select Case Err.Number

Case 31527
MsgBox "No Application Found"

Case Else
Err.Clear
End Select
End If
End Sub