Les chemins relatifs au lieu des chemins absolus dans Excel VBA

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

au moment où le fichier HTML est référencé avec un chemin absolu:

Workbooks.Open FileName:="C:Documents and SettingsSenior CatererMy DocumentsEndurance CalculationTRICATEndurance Summary.html"

cependant je veux utiliser un chemin relatif pour y faire référence plutôt qu'absolu (c'est parce que je veux distribuer le tableur à des collègues qui pourraient ne pas utiliser la même structure de dossier). Comme le fichier html et le tableur excel même dossier que je n'aurais pas pensé que ce serait difficile, mais je suis juste complètement incapable de le faire. J'ai cherché sur le web et les solutions proposées sont toutes apparues très compliqué.

j'utilise Excel 2000 et 2002 au travail, mais comme j'ai l'intention de le distribuer j'ai envie de travailler avec autant de versions d'Excel que possible.

toute suggestion reçue avec gratitude.

36
demandé sur ashleedawg 2008-10-17 23:42:28

5 réponses

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

Workbooks.Open FileName:= ThisWorkbook.Path & "\TRICATEndurance Summary.html"
56
répondu dbb 2008-10-18 01:15:12

Vous pouvez utiliser l'un de ceux-ci pour la racine du chemin relatif:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path
17
répondu yalestar 2008-10-17 19:50:36

je pense que le problème est que l'ouverture du fichier sans chemin d'accès ne fonctionne que si votre "répertoire courant" est réglé correctement.

essayez de taper " Debug.Imprimer CurDir" dans la fenêtre immédiate - qui devrait montrer l'emplacement de vos fichiers par défaut comme défini dans les outils...Option.

Je ne suis pas sûr d'être entièrement satisfait, peut-être parce que c'est un peu une commande VB d'héritage, mais vous pouvez faire ceci:

ChDir ThisWorkbook.Path
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
2
répondu Mike Woodhouse 2008-10-17 20:53:59

Vous pouvez fournir plus de flexibilité à vos utilisateurs en fournir 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é

1
répondu Simpal Kumar 2014-01-13 19:27:00

je pense que cela peut aider. La Macro vérifie ci-dessous si le dossier existe, sinon crée le dossier et enregistre dans les formats XLS et pdf dans ce dossier. 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
-1
répondu Lurds 2015-10-14 11:48:16