Some of the macro is no longer working in Window 7. For example, the following code need to modified in a way that's acceptable by Window 7. It get stuck in "Set db = OpenDatabase(strSourceFile, False, True, strOptions)"
Private Sub RunSQL(strSourceFile As String, strSQL As String, booHeader As Boolean, rgeTarget As Range, Optional shtTarget As Worksheet)
Dim db As DAO.Database, rs As DAO.Recordset, f As Integer, r As Long, strOptions As String
If rgeTarget Is Nothing Then GoTo CleanupRunSQL
strOptions = "Text;"
If LCase(Right(strSourceFile, 4)) = ".xls" Then strOptions = "Excel 8.0;"
strOptions = strOptions & "HDR="
If booHeader = False Then
strOptions = strOptions & "No;"
Else: strOptions = strOptions & "Yes;"
End If
On Error Resume Next
If strSourceFile = ThisWorkbook.FullName Then
Application.DisplayAlerts = False
strSourceFile = ThisWorkbook.path & "\" & "tempdao.xls"
ThisWorkbook.SaveCopyAs strSourceFile
Application.DisplayAlerts = True
End If
Set db = OpenDatabase(strSourceFile, False, True, strOptions)
On Error GoTo 0
If db Is Nothing Then
MsgBox "Error: Can't find the source file:" & vbCrLf & vbCrLf & _
strSourceFile, vbExclamation
GoTo CleanupRunSQL
End If
On Error Resume Next
Set rs = db.OpenRecordset(strSQL)
On Error GoTo 0
If rs Is Nothing Then
MsgBox "NOTE: No records match the data extract criteria.", vbInformation
GoTo CleanupRunSQL
End If
RStoDestination rs, rgeTarget, shtTarget
CleanupRunSQL:
On Error Resume Next
Set rgeTarget = Nothing
Set shtTarget = Nothing
rs.Close
Set rs = Nothing
db.Close
Set db = Nothing
Kill ThisWorkbook.path & "\" & "tempdao.xls"
On Error GoTo 0
End Sub
Bookmarks