Newsgroup: it.comp.appl.access
Titolo: Trovare altro db

Ho distribuito un applicativo "precaricato" con i dati di una serie di corsi
da gestire.
Purtroppo mi si dice solo ora che ci sono altri corsi.
Penso di creare una query di accodamento per aggiungere i nuovi dati a
quelli vecchi ma come posso fare per chiedere il percorso del primo db ?
--------------------------------
Inviato via 
http://arianna.libero.it/usenet/

 ha scritto nel messaggio 
news:195Z62Z170Z18Y1...@usenet.libero.it...

Ti crei una maschera che si apre all'avvio dove richiedi il percorso 
cliccando su un pulsate a cui assocerai questo codice
e dove al posto di "tuacasella" inserirai il nome da te scelto.
'Autore    :  Roberto da Parma
   Dim lngFlags         As Long
   Dim gfni             As bac_accOfficeGetFileNameInfo
   Dim Result           As String
   Dim percorso         As String
   On Error GoTo HandleErrors
   lngFlags = lngFlags Or bacGfniConfirmReplace
   lngFlags = lngFlags Or bacGfniNoChangeDir
   'lngFlags = lngFlags Or bacGfniAllowMultiSelect
   'lngFlags = lngFlags Or bacGfniDirectoryOnly
   lngFlags = lngFlags Or bacGfniInitializeView
   With gfni
      .lngView = 1
      .lngFlags = lngFlags
      ' Make sure not to pass in Null values. adhOfficeGetFile
      ' doesn't like that, and often GPFs.
      .strFilter = "Tutti i file (*.*)" & _
                   "|Microsoft Office Access (*.mdb)"
      .lngFilterIndex = 0
      '.strFile = ""
      .strDlgTitle = "Seleziona file"
      .strOpenTitle = "Inserisci"
      If IsNull(Me.tuacasella) Or Me.tuacasella = "" Then
        percorso = Environ("%USERPROFILE%\Desktop")
      Else
        .strInitialDir = Application.CurrentProject.Path
      End If
      .hwndOwner = Application.hWndAccessApp
   End With
   If baOfficeGetFileName(gfni, True) = bacAccErrSuccess Then
      Result = Trim(gfni.strFile)
      If Not IsNull(Result) Then
      On Error GoTo err
         Me.tuacasella = Result
      End If
    End If
ExitHere:
    Exit Sub
HandleErrors:
   If err.Number = 3021 Then Resume Next
   MsgBox "Error: " & err.Description & " (" & err.Number & ")"
   Resume ExitHere
err:
    DoCmd.RunCommand acCmdUndo
    Resume ExitHere
End Sub
Crei un modulo dove incolli questo codice
Option Compare Database
Option Explicit
Private Declare Function ba_accOfficeGetFileName _
 Lib "msaccess.exe" Alias "#56" _
 (gfni As bac_accOfficeGetFileNameInfo, fOpen As Integer) As Long
' Common Dialogs
Public Const bacAccErrSuccess = 0
Public Const bacAccErrUnknown = -1
Public Const bacAccErrRegKeyNotFound = -201
Public Const bacAccErrRegValueNotFound = -202
Public Const bacAccErrRegCantSetValue = -203
Public Const bacAccErrRegSubKeyNotFound = -204
Public Const bacAccErrRegTypeNotSupported = -205
Public Const bacAccErrRegCantCreateKey = -206
Public Const bacAccErrRegBufferTooSmall = -207
Public Const bacAccErrRegCantDeleteValue = -208
' OfficeGetFileName errors
Public Const bacAccErrGFNSuccess = 0
Public Const bacAccErrGFNCantOpenDialog = -301
Public Const bacAccErrGFNUserCancelledDialog = -302
' OfficeGetFileName flags
Public Const bacGfniConfirmReplace = &H1              ' Prompt if 
overwriting a file?
Public Const bacGfniNoChangeDir = &H2                 ' Don't change to the 
directory the user selected?
Public Const bacGfniAllowMultiSelect = &H8            ' Allow 
multiple-selection?
Public Const bacGfniDirectoryOnly = &H20              ' Open as directory 
picker?
Public Const bacGfniInitializeView = &H40             ' Initialize the view 
to the lView member or use last selected view?
' Views in the Office Find File dialog
Public Const bacGfniViewDetails = 0                  ' Details
Public Const bacGfniViewPreview = 1                  ' Preview
Public Const bacGfniViewProperties = 2               ' Properties
Public Const bacGfniViewList = 3                     ' List (typical)
Public Type bac_accOfficeGetFileNameInfo
    hwndOwner As Long
    strAppName As String * 255
    strDlgTitle As String * 255
    strOpenTitle As String * 255
    strFile As String * 4096
    strInitialDir As String * 255
    strFilter As String * 255
    lngFilterIndex As Long
    lngView As Long
    lngFlags As Long
End Type
Public Function baOfficeGetFileName( _
 gfni As bac_accOfficeGetFileNameInfo, _
 ByVal fOpen As Integer) As Long
    ' Use the Office file selector common dialog
    ' exposed by Access.
    Dim lngReturn As Long
    With gfni
        .strAppName = RTrim$(.strAppName) & vbNullChar
        .strDlgTitle = RTrim$(.strDlgTitle) & vbNullChar
        .strOpenTitle = RTrim$(.strOpenTitle) & vbNullChar
        .strFile = RTrim$(.strFile) & vbNullChar
        .strInitialDir = RTrim$(.strInitialDir) & vbNullChar
        If Len(adhTrimNull(RTrim$(.strFilter))) = 0 Then
            .strFilter = "All Files (*.*)"
            .lngFilterIndex = 1
        End If
        .strFilter = RTrim$(.strFilter) & vbNullChar
        lngReturn = ba_accOfficeGetFileName(gfni, fOpen)
        .strAppName = adhTrimNull(.strAppName)
        .strDlgTitle = adhTrimNull(.strDlgTitle)
        .strOpenTitle = adhTrimNull(.strOpenTitle)
        .strFile = adhTrimNull(.strFile)
        .strInitialDir = adhTrimNull(.strInitialDir)
        .strFilter = adhTrimNull(.strFilter)
    End With
    baOfficeGetFileName = lngReturn
End Function
Private Function adhTrimNull(strVal As String) As String
    ' From Access 2000 Developer's Handbook, Volume I
    ' by Getz, Litwin, and Gilbert. (Sybex)
    ' Copyright 1999. All rights reserved.
    ' Trim the end of a string, stopping at the first
    ' null character.
    Dim intPos As Integer
    intPos = InStr(1, strVal, vbNullChar)
    Select Case intPos
        Case Is > 1
            adhTrimNull = Left$(strVal, intPos - 1)
        Case 0
            adhTrimNull = strVal
        Case 1
            adhTrimNull = vbNullString
    End Select
End Function
Public Function GetPathPart(strPath As String) As String
'*****************************************************************
'Nome      : GetPathPart (Function)
'Scopo   : Return Path name ONLY
'Autore    :  Roberto da Parma
'Inputs    : strPath="C:\Programmi\DataBase.mdb"
'Output    : GetPathPart="C:\Programmi\"
'*****************************************************************
    Dim intCounter As Integer
    For intCounter = Len(strPath) To 1 Step -1
      If Mid$(strPath, intCounter, 1) = "\" Then
        Exit For
      End If
    Next intCounter
    GetPathPart = Left$(strPath, intCounter)
End Function
Piů di cosě....č un Copy/Paste ...
Ciauz
--
Roberto da Parma 


Se ti do l'accesso da remoto me lo fai tu? : )
Copio, incollo e studio.
Grazie
