Vil gerne kunne åbne både .doc og .docx fra tekstboks

Smid dette i et modul og kald funktionen med det fulde stinavn på dokumentet, så åbner den i det program der er registreret i Windows til at åbne den.
Det virker således både med .doc og docx (+Excel, powerpoint o.s.v.)

Public Const Error_BADFILENAME As Long = 52
Public Const Error_INVALIDFILENAME As Long = 64
Public Const Error_DEVICEUNAVAILABLE As Long = 68
Public Const Error_DISKNOTREADY As Long = 71
Public Const Error_FILENOTFOUND As Long = 13


Public Function fhpFileOpen(strFileName As String) As String
' -----------------------------------------------------------------------------------
' Purpose    : Åbner en fil med det program der er registreret til filtypen
' Parameters :
' Returns    : String
' Created    : 11-07-06
' Modified  :
' Remarks    :
' -----------------------------------------------------------------------------------
On Error GoTo Error_fhpFileOpen
  Dim lngReturn As Long
  Dim strReturn As String
  Dim varTaskID As Variant
 
  lngReturn = apiShellExecute(hWndAccessApp, vbNullString, strFileName, vbNullString, vbNullString, WIN_NORMAL)
           
  If lngReturn > ERROR_SUCCESS Then
    strReturn = vbNullString
    lngReturn = -1
  Else
    Select Case lngReturn
      Case ERROR_NO_ASSOC:
        'Try the OpenWith dialog
        varTaskID = Shell("rundll32.exe shell32.dll,OpenAs_RunDLL " & strFileName, WIN_NORMAL)
        lngReturn = (varTaskID <> 0)
      Case ERROR_OUT_OF_MEM:
        strReturn = "Fejl: For lidt hukommelse/systemresourcer. Kan ikke åbne filen!"
      Case ERROR_FILE_NOT_FOUND:
        strReturn = "Fejl: Filen findes ikke.  Kan ikke åbne filen!"
      Case ERROR_PATH_NOT_FOUND:
        strReturn = "Fejl: Stien findes ikke. Kan ikke åbne filen!"
      Case ERROR_BAD_FORMAT:
        strReturn = "Fejl: Ukendt filformat. Kan ikke åbne filen!"
      Case Else:
        strReturn = "Ukendt fejl"
    End Select
  End If
 
  If strReturn = "" Then
    strReturn = vbNullString
  Else
    strReturn = ", " & strReturn
  End If
  fhpFileOpen = lngReturn & strReturn

Exit_fhpFileOpen:
  Exit Function

Error_fhpFileOpen:
  fhpFileOpen = "Unknown error"
  Select Case Err.Number
    Case 3021
    Case 2501
    Case Is < 0
    Case Else
      MsgBox Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error in procedure 'fhpFileOpen'"
  End Select
  Resume Exit_fhpFileOpen

End Function

for mig at se indeholder koden i #1 konstanter der ikke er defineret:
WIN_NORMAL og ERROR_whatever i case

Hej begge 2,

Jeg er heller ikke helt med på forslaget?

Desuden burde jeg nok have forklaret at mit access niveau er på begynder stadiet, så jeg kan ikke helt gennemskue hvor forslaget i givet fald skulle sættes ind i editoren?

Mvh
Joachim

UPS - forkert copy / paste

Private Const ERROR_SUCCESS = 32&
Private Const ERROR_NO_ASSOC = 31&
Private Const ERROR_OUT_OF_MEM = 0&
Private Const ERROR_FILE_NOT_FOUND = 2&
Private Const ERROR_PATH_NOT_FOUND = 3&
Private Const ERROR_BAD_FORMAT = 11&

Der er også det med WIN_NORMAL og apiShellExecute er vist kun defineret på forhånd fra access2003 og frem.
... men sammen med terry's svar her, er alle kort vist på bordet.

http://www.eksperten.dk/spm/794055

Du mener vel: Hvis ikke doc dokumentet findes, så åben docx - hvis det findes.

Et eller andet sted i koden må du have en linje i stil med:
  <Åben Word> path & dokumentnavn & ext

Her må du erstatte det med noget i denne retning:
  If Dir (path & dokumentnavn & ext)<>"" Then
    <Åben Word> path & dokumentnavn & ext
  Else
    If Dir (path & dokumentnavn & ".docx")<>"" Then
      <Åben Word> path & dokumentnavn & ".docx"
    Else
      MsgBox "Dokumentet findes ikke",,"OBS"
    End If
  End If

Ja netop det lyder mere rigtigt. Jeg har nok ikke været præcis nok i min beskrivelse. Jeg prøver lige denne her. Tak for indsatsen til alle.

Hej fdata,

Jeg kan ikke rigtigt få det til at virke. Her er den fulde kode som den ser ud nu. Der dobbelt klikkes i en tekstbox der hedder "Hrnr", hvis det har noget at sige?

Private Sub Hrnr_DblClick(Cancel As Integer)
    Dim loebeNr, fileName
    Const path = "P:\Security\Security rapporter\2011\", ext = ".doc"
   
    DoCmd.RunCommand acCmdSaveRecord
    loebeNr = Val(Left(Hrnr, 3))
    fileName = path & Format(loebeNr, Left("000", 3 + (loebeNr < 100))) & "-" & Right(Hrnr, 2) & ext
       
        Shell "cmd /c start """" """ & fileName & """"
End Sub

Mvh
Joachim

Så må det blive noget i retning af:

Private Sub Hrnr_DblClick(Cancel As Integer)
  Dim loebeNr, fileName
  Const path = "P:\Security\Security rapporter\2011\", ext = ".doc"
 
  DoCmd.RunCommand acCmdSaveRecord
  loebeNr = Val(Left(Hrnr, 3))
 
  fileName = path & Format(loebeNr, Left("000", 3 + (loebeNr < 100))) & "-" & Right(Hrnr, 2) & ext
  If Dir(fileName) <> "" Then
    Shell "cmd /c start """" """ & fileName & """"
  Else
    fileName = fileName & "x"
    If Dir(fileName) <> "" Then
      Shell "cmd /c start """" """ & fileName & """"
    Else
      MsgBox "Dokumentet findes ikke", , "OBS"
    End If
  End If

End Sub

Hej fdata,

Den er lige i skabet !!

Super, tak for hjælpen.

Sidst jeg gav point var der også flere der havde svaret. En enkelt følte sig måske lidt snydt. Er det ikke korrekt at det er dig der bør have de 60 point?

Mvh
Joachim

Lækkert.

M.h.t. point er det jo op til dig at fordele dem i forhold til værdien af de svar, der er indløbet. Den lange udgave er:
Svar, som du ikke har brugt, giver du 0. Har du kun haft glæde af eet svar, giver du det 100%. Har du brugt flere af svarene i din løsning, fordeler du pointene i forhold til nytteværdien.

... og så skal du måske lige huske på, at pointene jo kun er for sjov. De fleste "stamgæster" på e er ikke specielt fokuserede på at samle point. I sidste ende gælder det jo om at hjælpe hinanden og sprede lidt viden og erfaring. Kort og godt.

Det lyder fornuftigt og rigtigt.

tak for hjælpen og svaret !!

Velbekomme - og tak for point ;o)