Below is code I have that you should be able to remove the unnecessary parts and modify the rest to suit.
Sub Main()
Dim objApp As Object
Dim objAcad As AcadApplication
Dim objAcadDoc As AcadDocument
Dim objFSO As Scripting.FileSystemObject
Dim objFolder As Scripting.Folder
Dim objFile As Scripting.File
Dim objSSet As AcadSelectionSet
Dim shtFType(0) As Short
Dim objFData(0) As Object
Dim objBlockRef As AcadBlockReference
Dim objAttribRefs() As Object
Dim objAttribRef As AcadAttributeReference
Dim intCount As Integer
objApp = System.Runtime.InteropServices.Marshal.GetActiveObject("AutoCAD.Application")
objAcad = CType(objApp, AcadApplication)
objAcad.ActiveDocument.SetVariable("FILEDIA", 0)
objFSO = New Scripting.FileSystemObject
objFolder = objFSO.GetFolder("Z:\Products\AAAT\Experience Guide\Towns")
For Each objFile In objFolder.Files
If objFile.Name Like "*.dwt" = True Then
objAcadDoc = objAcad.Documents.Add(objFile.Path)
Do Until objAcad.GetAcadState.IsQuiescent = True
Loop
objAcadDoc.SendCommand("script " & Left(objFile.Path, Len(objFile.Path) - 4) & ".scr" & vbCr)
Do Until objAcad.GetAcadState.IsQuiescent = True
Loop
objSSet = objAcadDoc.SelectionSets.Add("SSET")
shtFType(0) = 8
objFData(0) = "*HOTEL,*ACCOM-LISTED,*ACCOM-DELISTED,*ACCOM-UNLISTED,TRIM-LINE,T??R-CITY*"
objSSet.Select(AcSelect.acSelectionSetAll, , , shtFType, objFData)
objSSet.Erase()
shtFType(0) = 2
objFData(0) = "COPYRIT"
objSSet.Select(AcSelect.acSelectionSetAll, , , shtFType, objFData)
For Each objBlockRef In objSSet
objAttribRefs = CType(objBlockRef.GetAttributes, [Object]())
For intCount = 0 To UBound(objAttribRefs)
objAttribRef = CType(objAttribRefs(intCount), AcadAttributeReference)
If objAttribRef.TagString = "DATE" Then objAttribRef.TextString = "0107"
Next intCount
Next objBlockRef
objSSet.Delete()
objAcadDoc.SaveAs(Left(objFile.Path, Len(objFile.Path) - 4) & ".dwg", AcSaveAsType.acNative)
objAcadDoc.Close()
End If
Next objFile
objAcad.ActiveDocument.SetVariable("FILEDIA", 1)
End Sub
