עזרה באקסס שמירת קובץ והחלפת קובץ קיים

ארי4791

משתמש צעיר
שלום וברכה.
יש לי קוד VBA לייצוא טבלה לאקסל, ואני רוצה שכאשר המשתמש בוחר איפה לשמור את הטבלה, אם יש שם כבר קובץ באותו השם במקום שיביא לי הודעה האם להחליף את הקובץ הקיים, שיעשה קוד שאני יגיד לו.
וביתר פירוט: יש לי קוד לייצוא טבלה בשם index ואני רוצה שאם כבר יש בתיקייה שבוחרים קובץ בשם זה הוא יחליף את השם לindex2, ואם יש כבר index2 שיחליף לindex3, וכן על זה הדרך.
האם יש איך לעשות את זה?
תודה רבה מראש.
 

אפר

סתם מתעניין...
מנוי פרימיום
שלום וברכה.
יש לי קוד VBA לייצוא טבלה לאקסל, ואני רוצה שכאשר המשתמש בוחר איפה לשמור את הטבלה, אם יש שם כבר קובץ באותו השם במקום שיביא לי הודעה האם להחליף את הקובץ הקיים, שיעשה קוד שאני יגיד לו.
וביתר פירוט: יש לי קוד לייצוא טבלה בשם index ואני רוצה שאם כבר יש בתיקייה שבוחרים קובץ בשם זה הוא יחליף את השם לindex2, ואם יש כבר index2 שיחליף לindex3, וכן על זה הדרך.
האם יש איך לעשות את זה?
תודה רבה מראש.
תחפש על dir
 

אפר

סתם מתעניין...
מנוי פרימיום
אבל אני לא יודע איפה המשתמש יבחר לשמור את הקובץ.
אני יודע שיכול להיות שיהיה שום עוד קובץ באותו השם, אבל לא איפה זה יהיה.
תודה.
תשתמש במשתנה אליו אתה מכניס נתיב עם חלון SAVEAS (אם תרצה אני אחפש אצלי ואעלה לך קוד לזה)
ועל זה תבדוק אם הקובץ קיים ובמידת הצורך תוסיף מספר
ואז תשמור לנתיב שבמשתנה
 

אפר

סתם מתעניין...
מנוי פרימיום
תשתמש במשתנה אליו אתה מכניס נתיב עם חלון SAVEAS (אם תרצה אני אחפש אצלי ואעלה לך קוד לזה)
ועל זה תבדוק אם הקובץ קיים ובמידת הצורך תוסיף מספר
ואז תשמור לנתיב שבמשתנה
קוד:
Option Compare Database
Option Explicit

Private Const OFN_ALLOWMULTISELECT As Long = &H200
Private Const OFN_CREATEPROMPT As Long = &H2000
Private Const OFN_ENABLEHOOK As Long = &H20
Private Const OFN_ENABLETEMPLATE As Long = &H40
Private Const OFN_ENABLETEMPLATEHANDLE As Long = &H80
Private Const OFN_EXPLORER As Long = &H80000
Private Const OFN_EXTENSIONDIFFERENT As Long = &H400
Private Const OFN_FILEMUSTEXIST As Long = &H1000
Private Const OFN_HIDEREADONLY As Long = &H4
Private Const OFN_LONGNAMES As Long = &H200000
Private Const OFN_NOCHANGEDIR As Long = &H8
Private Const OFN_NODEREFERENCELINKS As Long = &H100000
Private Const OFN_NOLONGNAMES As Long = &H40000
Private Const OFN_NONETWORKBUTTON As Long = &H20000
Private Const OFN_NOREADONLYRETURN As Long = &H8000&
Private Const OFN_NOTESTFILECREATE As Long = &H10000
Private Const OFN_NOVALIDATE As Long = &H100
Private Const OFN_OVERWRITEPROMPT As Long = &H2
Private Const OFN_PATHMUSTEXIST As Long = &H800
Private Const OFN_READONLY As Long = &H1
Private Const OFN_SHAREAWARE As Long = &H4000
Private Const OFN_SHAREFALLTHROUGH As Long = 2
Private Const OFN_SHAREWARN As Long = 0
Private Const OFN_SHARENOWARN As Long = 1
Private Const OFN_SHOWHELP As Long = &H10
Private Const OFS_MAXPATHNAME As Long = 260

#If Win64 Then

Private Type BROWSEINFO
    hOwner As LongPtr
    pidlRoot As LongPtr
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As LongPtr
    lParam As LongPtr
    iImage As Long
End Type

Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As LongPtr
    lpTemplateName As String
End Type

Public Declare PtrSafe Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As Boolean

#Else

Public Type BROWSEINFO
    hOwner As Long
    pidlRoot As Long
    pszDisplayName As String
    lpszTitle As String
    ulFlags As Long
    lpfn As Long
    lParam As Long
    iImage As Long
End Type

Public Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Public Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OPENFILENAME) As Long
Public Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare Function SHBrowseForFolder Lib "shell32.dll" Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal pszPath As String) As Boolean

#End If

Public Function BrowseFolder(szDialogTitle As String) As String
    Dim X As Long, BI As BROWSEINFO, dwIList As Variant
    Dim szPath As String, wPos As Integer

    With BI
        .hOwner = hWndAccessApp
        .lpszTitle = szDialogTitle
        .ulFlags = &H1 Or &H40    ' &H40 adds the "Create New Folder" button
    End With

    dwIList = SHBrowseForFolder(BI)
    szPath = VBA.Space$(512)
    X = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)

    If X Then
        wPos = InStr(szPath, VBA.CHR(0))
        BrowseFolder = LEFT$(szPath, wPos - 1)
    Else
        BrowseFolder = vbNullString
    End If
End Function

'This function shows the Windows Open File dialog with the specified
' parameters, and either returns the full path to the selected file,
' or an empty string if the user cancels.
Public Function OpenFile(ByVal Title As String, ByVal Filter As String, _
                         ByVal FilterIndex As Integer, ByVal StartPath As String, _
                         Optional OwnerForm As Form = Nothing) As String

'Create and populate an OPENFILENAME structure
'using the specified parameters
    Dim ofn As OPENFILENAME
    With ofn
        .lStructSize = Len(ofn)
        If OwnerForm Is Nothing Then
            .hwndOwner = 0
        Else
            .hwndOwner = OwnerForm.hWnd
        End If
        .lpstrFilter = Filter
        .nFilterIndex = FilterIndex
        .lpstrFile = VBA.Space$(1024) & vbNullChar & vbNullChar
        #If Win64 Then
            .nMaxFile = LenB(.lpstrFile) - 1
            .lStructSize = LenB(ofn)
        #Else
            .nMaxFile = Len(.lpstrFile) - 1
            .lStructSize = Len(ofn)
        #End If
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = vbNullChar & VBA.Space$(512) & vbNullChar & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = StartPath & vbNullChar & vbNullChar
        .lpstrTitle = Title
        .flags = OFN_FILEMUSTEXIST
    End With

    'Call the Windows API function to show the dialog
    If GetOpenFileName(ofn) = 0 Then
        'The user pressed cancel, so return an empty string
        OpenFile = vbNullString
    Else
        'The user selected a file, so remove the null-terminators
        ' and return the full path
        OpenFile = VBA.Trim$(VBA.LEFT$(ofn.lpstrFile, Len(ofn.lpstrFile) - 2))
    End If
End Function

Public Function SaveFile(ByVal Title As String, ByVal Filter As String, _
                         ByVal FilterIndex As Integer, ByVal StartPath As String, _
                         Optional OwnerForm As Form = Nothing) As String

    Dim ofn As OPENFILENAME
    With ofn
        .lStructSize = Len(ofn)
        If OwnerForm Is Nothing Then
            .hwndOwner = 0
        Else
            .hwndOwner = OwnerForm.hWnd
        End If
        .lpstrFilter = Filter
        .nFilterIndex = FilterIndex
        .lpstrFile = VBA.Space$(1024) & vbNullChar & vbNullChar
        #If Win64 Then
            .nMaxFile = LenB(.lpstrFile) - 1
            .lStructSize = LenB(ofn)
        #Else
            .nMaxFile = Len(.lpstrFile) - 1
            .lStructSize = Len(ofn)
        #End If
        .nMaxFile = Len(.lpstrFile)
        .lpstrFileTitle = vbNullChar & VBA.Space$(512) & vbNullChar & vbNullChar
        .nMaxFileTitle = Len(.lpstrFileTitle)
        .lpstrInitialDir = StartPath & vbNullChar & vbNullChar
        .lpstrTitle = Title
        .flags = OFN_FILEMUSTEXIST
    End With

    'Call the Windows API function to show the dialog
    If GetSaveFileName(ofn) = 0 Then
        'The user pressed cancel, so return an empty string
        SaveFile = vbNullString
    Else
        'The user selected a file, so remove the null-terminators
        ' and return the full path
        SaveFile = VBA.Trim$(VBA.LEFT$(ofn.lpstrFile, Len(ofn.lpstrFile) - 2))
    End If
End Function
 

אולי מעניין אותך גם...

הפרק היומי

הפרק היומי! כל ערב פרק תהילים חדש. הצטרפו אלינו לקריאת תהילים משותפת!


תהילים פרק קיט ב'

ט בַּמֶּה יְזַכֶּה נַּעַר אֶת אָרְחוֹ לִשְׁמֹר כִּדְבָרֶךָ:י בְּכָל לִבִּי דְרַשְׁתִּיךָ אַל תַּשְׁגֵּנִי מִמִּצְוֹתֶיךָ:יא בְּלִבִּי צָפַנְתִּי אִמְרָתֶךָ לְמַעַן לֹא אֶחֱטָא לָךְ:יב בָּרוּךְ אַתָּה יְהוָה לַמְּדֵנִי חֻקֶּיךָ:יג בִּשְׂפָתַי סִפַּרְתִּי כֹּל מִשְׁפְּטֵי פִיךָ:יד בְּדֶרֶךְ עֵדְוֹתֶיךָ שַׂשְׂתִּי כְּעַל כָּל הוֹן:טו בְּפִקֻּדֶיךָ אָשִׂיחָה וְאַבִּיטָה אֹרְחֹתֶיךָ:טז בְּחֻקֹּתֶיךָ אֶשְׁתַּעֲשָׁע לֹא אֶשְׁכַּח דְּבָרֶךָ:
נקרא  5  פעמים

לוח מודעות

למעלה