Chemins relatifs au lieu de chemins absolus dans Excel VBA

Question

J'ai écrit une macro VBA Excel qui importe les données d'un fichier HTML (stocké localement) avant d'effectuer des calculs sur les données.

Pour le moment, le fichier HTML est référencé avec un chemin absolu:

Workbooks.Open FileName:="C:\Documents and Settings\Senior Caterer\My Documents\Endurance Calculation\TRICATEndurance Summary.html"

Toutefois, je souhaite utiliser un chemin relatif pour y faire référence, par opposition à absolu (c'est parce que je souhaite distribuer le tableur à des collègues qui pourraient ne pas utiliser la même structure de dossiers). Comme le fichier html et la feuille de calcul Excel se trouvent dans le même dossier, je n'aurais pas pensé que cela serait difficile, mais je suis tout à fait incapable de le faire. J'ai effectué des recherches sur le Web et les solutions proposées ont toutes paru très compliquées.

J'utilise Excel 2000 et 2002 au travail, mais comme je prévois de le distribuer, je souhaite qu'il fonctionne avec autant de versions d'Excel que possible.

Toutes les suggestions reçues avec gratitude.

Answer 1

Juste pour clarifier ce que yalestar a dit, cela vous donnera le chemin relatif:

Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html"

Answer 2

Vous pouvez utiliser l'un de ces éléments pour la racine du chemin relatif:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 3

Je pense que le problème est que l'ouverture du fichier sans chemin d'accès ne fonctionnera que si votre " répertoire actuel " est défini correctement.

Essayez de saisir " Debug.Print CurDir " dans la fenêtre Immédiate - devrait indiquer l'emplacement de vos fichiers par défaut, défini dans Outils ... Options.

Je ne suis pas sûr d'en être totalement satisfait, peut-être parce que c'est une commande VB héritée, mais vous pouvez le faire:

ChDir ThisWorkbook.Path

Je pense que je préférerais utiliser ThisWorkbook.Path pour créer un chemin d'accès au fichier HTML. Je suis un grand fan de FileSystemObject dans Scripting Runtime (qui semble toujours être installé). Je serais donc plus heureux de procéder de la sorte (après avoir défini une référence à Microsoft Scripting Runtime):

Const HTML_FILE_NAME As String = "my_input.html"

With New FileSystemObject
    With .OpenTextFile(.BuildPath(ThisWorkbook.Path, HTML_FILE_NAME), ForReading)
        ' Now we have a TextStream object that we can use to read the file
    End With
End With

Answer 4

Vous pouvez offrir plus de flexibilité à vos utilisateurs en leur fournissant le bouton du navigateur

.

Private Sub btn_browser_file_Click()
Dim xRow As Long
Dim sh1 As Worksheet
Dim xl_app As Excel.Application
Dim xl_wk As Excel.Workbook
Dim WS As Workbook
Dim xDirect$, xFname$, InitialFoldr$
InitialFoldr$ = "C:\"
With Application.FileDialog(msoFileDialogFolderPicker)
    .InitialFileName = Application.DefaultFilePath & "\"
    .Title = "Please select a folder to list Files from"
    .InitialFileName = InitialFoldr$
    .Show
    Range("H13").Activate
    If .SelectedItems.Count <> 0 Then
        xDirect$ = .SelectedItems(1) & "\"
         Range("h12").Value = xDirect$
        xFname$ = Dir(xDirect$, 7)
        Do While xFname$ <> ""
         If (Format(FileDateTime(xDirect$ & "\" & xFname$), "MM/DD/YYYY") > Format(Range("H10").Value, "MM/DD/YYYY")) Then
            ActiveCell.Offset(xRow) = xFname$
            xRow = xRow + 1
            xFname$ = Dir
            Else
            xFname$ = Dir
            xRow = xRow
        End If
        Loop
    End If
End With

avec ce morceau de code, vous pouvez y arriver facilement. Code testé

Answer 5

si le répertoire actuel du système d'exploitation est le chemin du classeur que vous utilisez, Workbooks.Open FileName: = "TRICATEndurance Summary.html" suffirait. si vous effectuez des calculs avec le chemin, vous pouvez vous référer au répertoire en cours en tant que . puis \ pour indiquer que le fichier se trouve dans ce répertoire et que vous devez le modifier. Le répertoire actuel du système d'exploitation sur le chemin de votre classeur, vous pouvez utiliser ChDrive et ChDir pour le faire.

ChDrive ThisWorkbook.Path
ChDir ThisWorkbook.Path
Workbooks.Open FileName:= ".\TRICATEndurance Summary.html"

Answer 6

Je pense que cela peut aider. Au-dessous de la macro vérifie si le dossier existe, sinon, créez-le et enregistrez-le aux formats xls et pdf. Il arrive que le dossier soit partagé avec les personnes impliquées afin que tout le monde soit mis à jour.

Sub PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco()
'
' PDF_laudo_e_Prod_SP_Sem_Ajuste_Preco Macro
'

'


Dim MyFolder As String
Dim LaudoName As String
Dim NF1Name As String
Dim OrigFolder As String

MyFolder = ThisWorkbook.path & "\" & Sheets("Laudo").Range("C9")
LaudoName = Sheets("Laudo").Range("K27")
NF1Name = Sheets("PROD SP sem ajuste").Range("Q3")
OrigFolder = ThisWorkbook.path

Sheets("Laudo").Select
Columns("D:P").Select
Selection.EntireColumn.Hidden = True

If Dir(MyFolder, vbDirectory) <> "" Then
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName

Application.DisplayAlerts = False

ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta"

Application.DisplayAlerts = True

Else
MkDir MyFolder
Sheets("Laudo").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & LaudoName & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

Sheets("PROD SP sem ajuste").ExportAsFixedFormat Type:=xlTypePDF, filename:=MyFolder & "\" & NF1Name & ".pdf", Quality:=xlQualityMinimum, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
False

ThisWorkbook.SaveAs filename:=MyFolder & "\" & LaudoName

Application.DisplayAlerts = False

ThisWorkbook.SaveAs filename:=OrigFolder & "\" & "Entregas e Instrucao Barter 2015 - beta"

Application.DisplayAlerts = True

End If

Sheets("Laudo").Select
Columns("C:Q").Select
Selection.EntireColumn.Hidden = False
Range("A1").Select

End Sub