On Error Resume Next

Const HKEY_LOCAL_MACHINE = &H80000002

strComputer = "."

strKeyPath = ""

Set objRegistry = GetObject("winmgmts:\\" & strComputer & "\root\default:StdRegProv")

Set filesys = CreateObject("Scripting.FileSystemObject")

'Increase size of array as per per files/foders number want to delete

Dim files(1),Folders(1)

'Assign files and folder to array

'Use Folder/file path is from user profile folder path

Files(0)="AppData\Local\Adobe\123.txt"

Files(1)="AppData\123.txt"

Folders(0)="AppData\Local\Adobe"

Folders(1)="AppData\123"

DeleteFolders(Folders)

DeleteFiles(Files)

Sub DeleteFiles(Files)

strKey="SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"

objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys

If IsArray(arrSubkeys) Then

For Each strSubkey In arrSubkeys

strKeyPath = strKey & "\" & strSubKey

strValueName = "ProfileImagePath"

objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue

If strValue<>"" Then

For Each file In Files

If file<>"" and filesys.FileExists(strValue & "\" & file)=True Then

filesys.DeleteFile strValue & "\" & file

End If

Next

End If

Next

End If

End Sub

Sub DeleteFolders(Folders)

strKey="SOFTWARE\Microsoft\Windows NT\CurrentVersion\ProfileList"

objRegistry.EnumKey HKEY_LOCAL_MACHINE, strKey, arrSubkeys

If IsArray(arrSubkeys) Then

For Each strSubkey In arrSubkeys

strKeyPath = strKey & "\" & strSubKey

strValueName = "ProfileImagePath"

objRegistry.GetExpandedStringValue HKEY_LOCAL_MACHINE,strKeyPath,strValueName,strValue

If strValue<>"" Then

For Each Folder In Folders

If Folder<>"" and filesys.FolderExists(strValue & "\" & Folder)=True Then

filesys.DeleteFolder strValue & "\" & Folder,True

End If

Next

End If

Next

End If

End Sub