Windows 7 64bit 
Access 2010 32bit
I have an existing Access Database that used an imbedded macro to save a config text file. We recently upgraded laptops to 64 bit Windows 7 with Access 2010. Everything on the db works except the SaveAs button. When I click it, nothing occurs.
I have verified the trusted locations and the DLL References to no avail. I also updated the PtrSafe and LongPtr values and it is still not working. I can get it to compile, but no change. Any assistance you can provide would be most welcome. Below is the code in the macro.
Begin Code:
Option Compare Database
Option Explicit
Private sLastScriptFilePath As String
Private sLastHAType As String
' Common Dialog routine from: http://support.microsoft.com/?kbid=161286
Private Declare PtrSafe Function GetOpenFileName _
Lib "comdlg32.dll" Alias "GetOpenFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function GetSaveFileName _
Lib "comdlg32.dll" Alias "GetSaveFileNameA" _
(pOpenfilename As OPENFILENAME) As Long
Private Type OPENFILENAME
lStructSize As LongPtr
hwndOwner As LongPtr
hInstance As LongPtr
lpstrFilter As String
lpstrCustomFilter As String
nMaxCustFilter As LongPtr
nFilterIndex As LongPtr
lpstrFile As String
nMaxFile As LongPtr
lpstrFileTitle As String
nMaxFileTitle As LongPtr
lpstrInitialDir As String
lpstrTitle As String
flags As LongPtr
nFileOffset As Integer
nFileExtension As Integer
lpstrDefExt As String
lCustData As LongPtr
lpfnHook As LongPtr
lpTemplateName As String
End Type
' OFN constants.
Const OFN_ALLOWMULTISELECT As Long = &H200
Const OFN_CREATEPROMPT As Long = &H2000
Const OFN_EXPLORER As Long = &H80000
Const OFN_EXTENSIONDIFFERENT As Long = &H400
Const OFN_FILEMUSTEXIST As Long = &H1000
Const OFN_HIDEREADONLY As Long = &H4
Const OFN_LONGNAMES As Long = &H200000
Const OFN_NOCHANGEDIR As Long = &H8
Const OFN_NODEREFERENCELINKS As Long = &H100000
Const OFN_OVERWRITEPROMPT As Long = &H2
Const OFN_PATHMUSTEXIST As Long = &H800
Const OFN_READONLY As Long = &H1
' Concatenate a recordset of DNS proxy config commands into a single text string
Public Function ConcatDNS() As String
On Error GoTo Err_ConcatDNS
Dim db As DAO.Database
Dim rst As DAO.Recordset
ConcatDNS = ""
Set db = CurrentDb
Set rst = db.OpenRecordset("select cmdstring " & _
"from qryDNS_AllProxyCommands " & _
"order by SeqNum")
Do While Not rst.EOF
' Debug.Print rs![cmdstring]
ConcatDNS = ConcatDNS & rst![cmdstring] & Constants.vbCrLf
rst.MoveNext
Loop
Exit_ConcatDNS:
Set rst = Nothing
Set db = Nothing
Exit Function
Err_ConcatDNS:
Resume Exit_ConcatDNS
End Function
' Concatenate a recordset of HA-side FA-HA SPI config commands into a single text string
Public Function ConcatHA() As String
'On Error GoTo Err_ConcatHA
Dim db As DAO.Database
Dim rst As DAO.Recordset
ConcatHA = ""
Set db = CurrentDb
Set rst = db.OpenRecordset("select cmdstring " & _
"from qryHA_AllSPICommands " & _
"order by SeqNum")
Do While Not rst.EOF
' Debug.Print rs![cmdstring]
ConcatHA = ConcatHA & rst![cmdstring] & Constants.vbCrLf
rst.MoveNext
Loop
Exit_ConcatHA:
Set rst = Nothing
Set db = Nothing
Exit Function
Err_ConcatHA:
Resume Exit_ConcatHA
End Function
Public Function AskForScriptFilePath(dlgTitle As String, defaultName As String) As Boolean
Dim SaveFile As OPENFILENAME
Dim lReturn As Long
Dim sFilter As String
AskForScriptFilePath = False
SaveFile.lStructSize = LenB(SaveFile)
SaveFile.hwndOwner = Application.hWndAccessApp
SaveFile.hInstance = 0 ' XXX Not safe if multiple instances!!!
sFilter = "Starent Script File (*.cfg)" & Chr(0) & "*.CFG" & Chr(0)
SaveFile.lpstrFilter = sFilter
SaveFile.nFilterIndex = 1
SaveFile.lpstrFile = defaultName & String(257, 0)
SaveFile.nMaxFile = Len(SaveFile.lpstrFile) - 1
SaveFile.lpstrFileTitle = SaveFile.lpstrFile
SaveFile.nMaxFileTitle = SaveFile.nMaxFile
SaveFile.lpstrInitialDir = "My Documents"
SaveFile.lpstrTitle = dlgTitle
SaveFile.flags = OFN_OVERWRITEPROMPT
lReturn = GetSaveFileName(SaveFile)
If lReturn = 0 Then
MsgBox "Canceled"
sLastScriptFilePath = ""
Else
sLastScriptFilePath = Trim(SaveFile.lpstrFile)
sLastScriptFilePath = sLastScriptFilePath
'MsgBox "The user Chose " & sLastScriptFilePath
AskForScriptFilePath = True
End If
End Function
' Return most recent file path
Public Function LastScriptFilename() As String
LastScriptFilename = sLastScriptFilePath
End Function
' Write RecordSet to provided file
Public Function WriteScriptCommon(rs As DAO.Recordset, fnum As Integer) As Boolean
'On Error GoTo Err_WriteScriptCommon
WriteScriptCommon = False
Do While Not rs.EOF
Debug.Print rs![cmdstring]
Print #fnum, rs![cmdstring]
rs.MoveNext
Loop
WriteScriptCommon = True
GoTo Exit_WriteScriptCommon
Err_WriteScriptCommon:
Resume Exit_WriteScriptCommon
Exit_WriteScriptCommon:
If Not IsObject(rs) Then rs.Close
Close #fnum
Set rs = Nothing
End Function
' Save query rows to specified script file. Query is assumed to output field named cmdstring
Public Function SaveQueryToScript(selectQuery As String, scriptFilePath As String) As Boolean
Dim db As DAO.Database
Dim rs As DAO.Recordset
Dim fnum As Integer
'On Error GoTo Err_SaveQueryToScript
SaveQueryToScript = False
Set db = CurrentDb
fnum = FreeFile
Open scriptFilePath For Output As fnum
Print #fnum, "# Generated by VZW RoamerTool - " & Strings.Format(Now, "mm/dd/yyyy hh:mm:ss")
Set rs = db.OpenRecordset(selectQuery, , dbReadOnly)
SaveQueryToScript = WriteScriptCommon(rs, fnum)
GoTo Exit_SaveQueryToScript
Err_SaveQueryToScript:
Resume Exit_SaveQueryToScript
Exit_SaveQueryToScript:
If Not IsObject(rs) Then rs.Close
Set rs = Nothing
End Function
' Save query rows to specified script file (*.cfg), prompting for actual path.
' If the script filename passed contains the pattern YYYYMMDD it is replaced with
' the current date. Query is assumed to output a field named cmdstring.
Public Function SaveAsScriptDialog(selectQuery As String, ScriptFilenamePattern As String) As Boolean
Dim fn As String
SaveAsScriptDialog = False
fn = Strings.Replace(ScriptFilenamePattern, "YYYYMMDD", Strings.Format(Date, "yyyymmdd"))
SaveAsScriptDialog = AskForScriptFilePath("Save As", fn)
If SaveAsScriptDialog Then
SaveAsScriptDialog = SaveQueryToScript(selectQuery, LastScriptFilename())
End If
End Function
' Test
Public Function Try1() As Boolean
Dim b As Boolean
Dim fn As String
fn = "proxy-dns-dynamic-ha-update_" & Strings.Format(Date, "yyyymmdd") & ".cfg"
Try1 = AskForScriptFilePath("Save As", fn)
If Try1 Then
Try1 = SaveQueryToScript("select cmdstring from qryDNS_AllProxyCommands order by SeqNum", LastScriptFilename())
End If
End Function
' Return most recent HA Type selected
Public Function LastHAType() As String
LastHAType = sLastHAType
End Function
Public Sub SetLastHAType(HAType As String)
sLastHAType = HAType
End Sub
END CODE
Reply With Quote
