Newsgroup: it.comp.appl.access
Titolo: OutputTo acQuery

 
ho inserito, sotto la rutine evento click di un comendo il seguente codice
vba:
DoCmd.OutputTo acQuery, "prefattura", "MicrosoftExcel(*.xls)",
"c:\windows\desktop\NOME_FILE.xls", False, ""
il tutto funziona perfettamente e mi viene creato un file sul desktop.
il problema che ho č che se uso un pc dove non č installato W98 ma windows
XP il percorso che ho č il seguente:
C:\Documents and Settings\francesco\Desktop e non C:\windows\desktop
e mi crea un errore.
come posso sistemare il codice in modo tale da far si che, in ordine logico:
1:se esiste C:\windows\desktop allora mi crae il fili lě.
2: se non esiste allora mi crei il file in C:\Documents and
Settings\francesco1Desktop , tenendo altresě conto che anche altri magari
utilizzano su altri pc il comando e che quindi il percorso potrebbe essere
C:\Documents and Settings\TIZIO\Desktop
C:\Documents and Settings\CAIO\Desktop
C:\Documents and Settings\SEMPRONIO\Desktop ?
Un grazie anticipato.
francesco
--------------------------------
Inviato via 
http://arianna.libero.it/usenet/

 C:\Documents and Settings\SEMPRONIO\Desktop ?
Puoi copiarti il seguente codice da un amico in un modulo standard:
*******************
'code example by Jörg Ackermann
Private Declare Function GetEnvironmentVariable Lib "kernel32" _
                         Alias "GetEnvironmentVariableA" _
                         (ByVal lpName As String, _
                          ByVal lpBuffer As String, _
                          ByVal nSize As Long) As Long
Public Function getProfilePath() As String
  Dim strBuffer As String * 255
  Dim lngBuffLen As Long
  Dim strVarName As String
  Dim lngRetVal As Long
  strVarName = "Userprofile"
  lngBuffLen = Len(strBuffer)
  lngRetVal = GetEnvironmentVariable(strVarName, strBuffer, lngBuffLen)
  getProfilePath = left(strBuffer, (InStr(strBuffer, vbNullChar) - 1))
End Function
*******************
Poi usa il percorso dell'utente con:
DoCmd.OutputTo acQuery, "prefattura", "MicrosoftExcel(*.xls)",
getProfilePath & "\desktop\NOME_FILE.xls", False, ""
Non l'ho provato con Win98. Se ci sono problemi con Win9x puoi
prima ricavare la versione di Windows installato. p.e. con
http://www.mvps.org/access/api/api0055.htm
-- 
HTH
Karl
*********
Access FAQ: 
www.donkarl.com/it
+info sulla prima Conferenza Italiana per Sviluppatori di Access (CISA1) 

 C:\Documents and Settings\SEMPRONIO\Desktop ?
Aggiungi in un modulo VBA quanto segue:
Public Declare Function SHGetSpecialFolderPath Lib "shell32.dll" (ByVal 
hwndOwner As Long, ByVal lpszPath As String, ByVal nFolder As Long, ByVal 
fCreate As Long) As Long
Public Function getUserDesktop(MyhWnd As Long) As String
    Dim UserDeskCSIDL As Long
    Dim Risultato As String * 512 ' MAX_PATH vale in genere 260, qui 
abbondiamo
    UserDeskCSIDL = 16
    If SHGetSpecialFolderPath(MyhWnd, Risultato, UserDeskCSIDL, 0) Then
        getUserDesktop = Risultato
    End If
End Function
poi all'interno di un form puoi ottenere il percorso completo del desktop 
dell'utente con
Perc = getUserDesktop(Me.hWnd)
Questa cosa funziona con tutte le versioni di Windows con Internet Explorer 
4.0 o superiore.
IG

 getProfilePath & "\desktop\NOME_FILE.xls", False, ""
adesso perň il problema mi si č invertito nel senso che funziona con Xp ma
non con 98.
come posso fare?
come posso utilizzare il codice di:
http://www.mvps.org/access/api/api0055.htm
?
grazie francesco


 ?
Copia la seguente versione semplificata in un modulo standard:
' ******** Code Start ********
 'This code was originally written by Dev Ashish.
 'It is not to be altered or distributed,
 'except as part of an application.
 'You are free to use it in any application,
 'provided the copyright notice is left unchanged.
 '
 'Code Courtesy of
 'Dev Ashish
 '
http://www.mvps.org/access/api/api0055.htm
Private Type OSVERSIONINFO
    dwOSVersionInfoSize As Long
    dwMajorVersion As Long
    dwMinorVersion As Long
    dwBuildNumber As Long
    dwPlatformId As Long
    szCSDVersion As String * 128
End Type
Private Declare Function apiGetVersionEx Lib "kernel32" _
    Alias "GetVersionExA" _
    (lpVersionInformation As Any) _
    As Long
Private Const VER_PLATFORM_WIN32_WINDOWS = 1
Private Const VER_PLATFORM_WIN32_NT = 2
Function fOSName() As String
Dim osvi As OSVERSIONINFO
Dim strOut As String
    osvi.dwOSVersionInfoSize = Len(osvi)
    If CBool(apiGetVersionEx(osvi)) Then
        With osvi
            ' Win 2000
            If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
                .dwMajorVersion = 5 Then
                    strOut = "2000"
            End If
            End If
            ' XP
            If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
                .dwMajorVersion = 5 And _
                .dwMinorVersion = 1 Then
                    strOut = "XP"
            End If
            ' .Net Server
            If .dwPlatformId = VER_PLATFORM_WIN32_NT And _
                .dwMajorVersion = 5 And _
                .dwMinorVersion = 2 Then
                    strOut = ".NET Server"
            End If
            ' Win ME
            If (.dwMajorVersion = 4 And _
                (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                .dwMinorVersion = 90)) Then
                    strOut = "Me"
            End If
            ' Win 98
            If (.dwMajorVersion = 4 And _
                (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                .dwMinorVersion = 10)) Then
                    strOut = "98"
            End If
            ' Win 95
            If (.dwPlatformId = VER_PLATFORM_WIN32_WINDOWS And _
                .dwMinorVersion = 0) Then
                    strOut = "95"
            End If
            ' Win NT
            If (.dwPlatformId = VER_PLATFORM_WIN32_NT And _
                .dwMajorVersion <= 4) Then
                strOut = "NT"
            End If
        End With
    End If
    fOSName = strOut
End Function
Private Function fTrimNull(strIn As String) As String
Dim intPos As Integer
    intPos = InStr(1, strIn, vbNullChar)
    If intPos Then
        fTrimNull = Mid$(strIn, 1, intPos - 1)
    Else
        fTrimNull = strIn
    End If
End Function
'   ********** Code End **********
Poi prova se funziona con:
Select Case fOSName
    Case "95", "98","Me"
        'qui il tuo vecchio codice che funziona con Win98 ecc.
    Case Else
        'qui il nuovo codice che funziona con XP ecc.
End Select


 ha scritto nel messaggio 
news:81Z72Z126Z200Y...@usenet.libero.it...

Prova cosě:
percorso = Environ("userprofile") & "\Desktop\"
DoCmd.OutputTo acOutputQuery, "tua_query", acFormatXLS, percorso & 
"tuo_nome.xls", True
Ciao
Roberto