النسبي بدلاً من المسارات المطلقة في Excel VBA

Question

لقد كتبت ماكرو Excel VBA يستورد البيانات من ملف HTML (مخزّن محليًا) قبل إجراء الحسابات على البيانات.

في الوقت الحالي ، يشار إلى ملف HTML بالمسار المطلق:

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

ومع ذلك ، أريد استخدام مسار نسبي للإشارة إليه بدلاً من المطلق (هذا لأنني أريد توزيع جدول البيانات على الزملاء الذين قد لا يستخدمون هيكل المجلد نفسه). نظرًا لأن ملف HTML وجدول بيانات Excel يجلسون في نفس المجلد ، لم أكن أعتقد أن هذا سيكون صعبًا ، لكنني غير قادر تمامًا على القيام بذلك. لقد بحثت على الويب وظهرت جميع الحلول المقترحة معقدة للغاية.

أنا أستخدم Excel 2000 و 2002 في العمل ، لكنني أخطط لتوزيعه ، أريد أن يعمل مع أكبر عدد ممكن من إصدارات Excel.

أي اقتراحات تلقيت بامتنان.

Answer 1

فقط لتوضيح ما قاله Yalestar ، سيعطيك هذا المسار النسبي:

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

Answer 2

يمكنك استخدام واحدة من هذه لجذر المسار النسبي:

ActiveWorkbook.Path
ThisWorkbook.Path
App.Path

Answer 3

أعتقد أن المشكلة هي أن فتح الملف بدون مسار لن يعمل إلا إذا تم تعيين "الدليل الحالي" بشكل صحيح.

حاول كتابة "debug.print curdir" في النافذة المباشرة - يجب أن تعرض موقع ملفاتك الافتراضية على النحو المحدد في الأدوات ... خيارات.

لست متأكدًا من أنني سعيد تمامًا به ، ربما لأنه أمر قديم إلى حد ما ، ولكن يمكنك القيام بذلك:

ChDir ThisWorkbook.Path

أعتقد أنني أفضل استخدام thisworkbook.path لإنشاء مسار إلى ملف HTML. أنا معجب كبير بـ FileSystemObject في وقت تشغيل البرمجة النصية (والذي يبدو دائمًا مثبتًا) ، لذلك سأكون أكثر سعادة للقيام بشيء من هذا القبيل (بعد تحديد إشارة إلى وقت تشغيل البرمجة النصية Microsoft):

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

يمكنك توفير المزيد من المرونة للمستخدمين عن طريق توفير زر المتصفح لهم

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

مع هذه القطعة من الكود يمكنك تحقيق ذلك بسهولة. رمز تم اختباره

Answer 5

إذا كان الدليل الحالي لنظام التشغيل هو مسار المصنف الذي تستخدمه ، Workbooks.Open FileName:= "TRICATEndurance Summary.html" يكفي. إذا كنت تقوم بإجراء حسابات مع المسار ، فيمكنك الرجوع إلى الدليل الحالي باسم . وثم \ لإخبار الملف في هذا dir ، وفي حال كان عليك تغيير الدليل الحالي لنظام التشغيل إلى مسار المصنف الخاص بك ، يمكنك استخدام ChDrive و ChDir لنفعل ذلك.

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

Answer 6

أعتقد أن هذا قد يساعد. يتحقق الماكرو أدناه إذا كان المجلد موجودًا ، إذا لم يتم ذلك ، فقم بإنشاء المجلد وحفظه في كل من تنسيقات XLS و PDF في هذا المجلد. يحدث أن يتم مشاركة المجلد مع الأشخاص المعنيين حتى يتم تحديث الجميع.

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