+ Reply to Thread
Results 1 to 1 of 1

The API function GetOpenFileName does not work in Excel 2010, but works in Excel 2007

  1. #1
    Registered User
    Join Date
    04-26-2014
    Location
    England
    MS-Off Ver
    Excel 2010
    Posts
    1

    The API function GetOpenFileName does not work in Excel 2010, but works in Excel 2007

    The function GetOpenFileName does not work in Excel 2010 (32 bit) in Windows 7, but does work in Excel 2007 (32bit) in Windows. The window does not open and returns "false" to Output. To test the code, you need to run the sub startit.
    The problem happens in thCommonFileOpenSave, Line containing "If OpenFile Then fResult = th_apiGetOpenFileName(OFN) Else fResult = th_apiGetSaveFileName(OFN)"

    Code:

    Option Explicit

    Type thOPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    strFilter As String
    strCustomFilter As String
    nMaxCustFilter As String
    nFilterIndex As Long
    strFile As String
    nMaxFile As Long
    strFileTitle As String
    nMaxFileTitle As Long
    strInitialDir As String
    strTitle As String
    Flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    strDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
    End Type

    Declare Function th_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (OFN As thOPENFILENAME) As Boolean
    Declare Function th_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (OFN As thOPENFILENAME) As Boolean
    Declare Function CommDlgExtendetError Lib "commdlg32.dll" () As Long

    Private Const thOFN_READONLY = &H1
    Private Const thOFN_OVERWRITEPROMPT = &H2
    Private Const thOFN_HIDEREADONLY = &H4
    Private Const thOFN_NOCHANGEDIR = &H8
    Private Const thOFN_SHOWHELP = &H10
    Private Const thOFN_NOVALIDATE = &H100
    Private Const thOFN_ALLOWMULTISELECT = &H200
    Private Const thOFN_EXTENSIONDIFFERENT = &H400
    Private Const thOFN_PATHMUSTEXIST = &H800
    Private Const thOFN_FILEMUSTEXIST = &H1000
    Private Const thOFN_CREATEPROMPT = &H2000
    Private Const thOFN_SHAREWARE = &H4000
    Private Const thOFN_NOREADONLYRETURN = &H8000
    Private Const thOFN_NOTESTFILECREATE = &H10000
    Private Const thOFN_NONETWORKBUTTON = &H20000
    Private Const thOFN_NOLONGGAMES = &H40000
    Private Const thOFN_EXPLORER = &H80000
    Private Const thOFN_NODEREFERENCELINKS = &H100000
    Private Const thOFN_LONGNAMES = &H200000

    Function StartIt()
    Dim strFilter As String
    Dim Output As String
    Dim lngFlags As Long
    strFilter = thAddFilterItem(strFilter, "Excel Files (*.xls)", "*.XLS")
    strFilter = thAddFilterItem(strFilter, "Text Files(*.txt)", "*.TXT")
    strFilter = thAddFilterItem(strFilter, "All Files (*.*)", "*.*")
    Output = thCommonFileOpenSave(InitialDir:="C:\Windows", Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, DialogTitle:="File Browser")
    Debug.Print Hex(lngFlags)
    End Function

    Function GetOpenFile(Optional varDirectory As Variant, Optional varTitleForDialog As Variant) As Variant
    Dim strFilter As String
    Dim lngFlags As Long
    Dim varFileName As Variant
    lngFlags = thOFN_FILEMUSTEXIST Or thOFN_HIDEREADONLY Or thOFN_NOCHANGEDIR

    If IsMissing(varDirectory) Then varDirectory = ""

    If IsMissing(varTitleForDialog) Then varTitleForDialog = ""

    strFilter = thAddFilterItem(strFilter, "Excel (*.xls)", "*.XLS")
    varFileName = thCommonFileOpenSave(OpenFile:=True, InitialDir:=varDirectory, Filter:=strFilter, Flags:=lngFlags, DialogTitle:=varTitleForDialog)

    If Not IsNull(varFileName) Then varFileName = TrimNull(varFileName)

    GetOpenFile = varFileName

    End Function

    Function thCommonFileOpenSave(Optional ByRef Flags As Variant, Optional ByVal InitialDir As Variant, Optional ByVal Filter As Variant, _
    Optional ByVal FilterIndex As Variant, Optional ByVal DefaultEx As Variant, Optional ByVal fileName As Variant, _
    Optional ByVal DialogTitle As Variant, Optional ByVal hwnd As Variant, Optional ByVal OpenFile As Variant) As Variant

    Dim OFN As thOPENFILENAME
    Dim strFileName As String
    Dim FileTitle As String
    Dim fResult As Boolean

    If IsMissing(InitialDir) Then InitialDir = CurDir
    If IsMissing(Filter) Then Filter = ""
    If IsMissing(FilterIndex) Then FilterIndex = 1
    If IsMissing(Flags) Then Flags = 0&
    If IsMissing(DefaultEx) Then DefaultEx = ""
    If IsMissing(fileName) Then fileName = ""
    If IsMissing(DialogTitle) Then DialogTitle = ""
    If IsMissing(hwnd) Then hwnd = 0
    If IsMissing(OpenFile) Then OpenFile = True

    strFileName = Left(fileName & String(256, 0), 256)
    FileTitle = String(256, 0)

    With OFN
    .lStructSize = Len(OFN)
    .hwndOwner = hwnd
    .strFilter = Filter
    .nFilterIndex = FilterIndex
    .strFile = strFileName
    .nMaxFile = Len(strFileName)
    .strFileTitle = FileTitle
    .nMaxFileTitle = Len(FileTitle)
    .strTitle = DialogTitle
    .Flags = Flags
    .strDefExt = DefaultEx
    .strInitialDir = InitialDir
    .hInstance = 0
    .lpfnHook = 0
    .strCustomFilter = String(255, 0)
    .nMaxCustFilter = 255
    End With

    If OpenFile Then fResult = th_apiGetOpenFileName(OFN) Else fResult = th_apiGetSaveFileName(OFN)


    If fResult Then
    If Not IsMissing(Flags) Then Flags = OFN.Flags
    thCommonFileOpenSave = TrimNull(OFN.strFile)
    Else
    thCommonFileOpenSave = vbNullString
    End If

    End Function

    Function thAddFilterItem(strFilter As String, strDescription As String, Optional varItem As Variant) As String

    If IsMissing(varItem) Then varItem = "*.*"
    thAddFilterItem = strFilter & strDescription & vbNullChar & varItem & vbNullChar

    End Function

    Private Function TrimNull(ByVal strItem As String) As String
    Dim intPos As Integer
    intPos = InStr(strItem, vbNullChar)
    If intPos > 0 Then
    TrimNull = Left(strItem, intPos - 1)
    Else
    TrimNull = strItem
    End If

    End Function
    Attached Files Attached Files

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Get code that works on excel version 2007 to work on version 2010
    By Agent1 in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 12-21-2014, 01:23 AM
  2. Replies: 4
    Last Post: 04-10-2014, 12:11 PM
  3. Replies: 10
    Last Post: 08-20-2013, 01:02 PM
  4. Why and If statement works in Excel 2007 but fails to work in Excel 2010?
    By Superfly1984 in forum Excel Formulas & Functions
    Replies: 6
    Last Post: 05-03-2013, 08:26 AM
  5. Why does this following macro not work in 2010 but works in 2007?
    By Hyflex in forum Excel Programming / VBA / Macros
    Replies: 3
    Last Post: 11-06-2012, 01:23 PM

Tags for this Thread

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1