从根据单元格值的不同路径导入Excel工作簿。

huangapple go评论61阅读模式
英文:

Import Excel Workbook from variable path depending on cell value

问题

我是完全新手,对这种VBA语言一无所知,我需要帮助。

我有一些工作簿,需要从我每隔几个月制作的某些Excel导出中导入信息(这些工作簿每个只有一个工作表)。

这些导出文件将位于服务器上的某个路径中,路径的文件夹名称与我的主要工作簿中“B2”单元格的值相同。

我需要从这些文件中导入信息的路径将是:\\Server-Name\MainFolder\SubFolder\SubSubFolder\

其中:

MainFolder始终具有相同的名称

SubFolder的名称等于我需要导入到主要工作簿中的导出/工作簿的日期

SubSubFolder名称=每个需要进行导入的工作簿中的B2单元格

我可以根据导出日期每次更改代码/路径的第一个子文件夹,不必在代码中进行自动化,因为日期可能会有所变化(或者我们可以找到将系统日期放在这里的解决方案),但我需要Excel从那个特定路径中导入“Kosten.xlsx”、“Belege.xlsx”和“Zeiten.xlsx”中的信息(这3个是我每隔几个月制作的导出文件)。

我已经成功编写了用于导入信息的代码(宏),但我需要提取信息的文件必须与我正在工作的工作簿位于同一个文件夹中。

Sub import_sheets

Dim Pfad, Datei As String
Pfad = ActiveWorkbook.Path & "\"
Datei = ActiveWorkbook.Name

Sheets("FW-ProjAuswertMatSEK").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Kosten.xlsx" 
Columns("A:L").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Kosten.xlsx").Close

Sheets("FW-PrjAuswertStunden").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Zeiten.xlsx"
Columns("A:H").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Zeiten.xlsx").Close

Sheets("FW-Bestell-Lief-Pos").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Belege.xlsx" 
Columns("A:O").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Belege.xlsx").Close

Sheets("Übersicht").Select

End Sub

这是你提供的VBA代码的一部分,用于导入工作簿中的信息。这部分代码打开特定的Excel文件,复制其内容,然后将其粘贴到当前工作簿中。希望这有所帮助。

英文:

I am completely new at this VBA language, and i am in need of help.

I have a few workbooks in which i need to import information from certain excel exports i make every few months. (these workbooks have only one sheet each)

These exports will be in a certain path on the server in folders that have the name equal to value of "B2" cell in my main workbooks.

The path of the files i need to import info from would be: \\Server-Name\MainFolder\SubFolder\SubSubFolder\

Where:

MainFolder has always the same name

SubFolder name = the date of the exports/workbooks that i need to import in my main workbooks

SubSubFolder name = cell B2 in each workbook i need to make the import

I can change the code/path regarding the first subfolder every time i make the exports according to the date of the exports, i do not necessary need that to be automated in the code because the date may vary (or we can find a solution to put in here the date of the system), but i need Excel to import the info from "Kosten.xlsx", "Belege.xlsx", and "Zeiten.xlsx" (these 3 are the exports i make every few months) from that certain path.

I managed to write the code (Macro) for importing the information, but the files i need info from need to be in the same folder as the workbook i work in.

Sub import_sheets

Dim Pfad, Datei As String
Pfad = ActiveWorkbook.Path & "\"
Datei = ActiveWorkbook.Name

Sheets("FW-ProjAuswertMatSEK").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Kosten.xlsx" 
Columns("A:L").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Kosten.xlsx").Close

Sheets("FW-PrjAuswertStunden").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Zeiten.xlsx"
Columns("A:H").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Zeiten.xlsx").Close

Sheets("FW-Bestell-Lief-Pos").Select
Range("A1").Select
Workbooks.Open Filename:=Pfad & "Belege.xlsx" 
Columns("A:O").Select
Selection.Copy
Windows(Datei).Activate
ActiveSheet.Paste
Windows("Belege.xlsx").Close

Sheets("Übersicht").Select

End Sub

答案1

得分: 1

请尝试以下方式:

Sub import_sheets()
    Const MAIN_FLD As String = "\\服务器名称\主文件夹\"
    
    Dim wb As Workbook, Pfad As String, ssf As String, dt As Date
    
    Set wb = ThisWorkbook '如果与运行代码的工作簿相同
    With wb.Worksheets("info")    '例如,包含日期/文件夹信息的工作表
        dt = .Range("B1").Value   '日期
        ssf = .Range("B2").Value  '子子文件夹
    End With
    
    '构建路径
    Pfad = MAIN_FLD & Format(dt, "yyy-mm-dd") & "\" & ssf & "\"
    
    With Workbooks.Open(Filename:=Pfad & "Kosten.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:L").Copy _
                wb.Worksheets("FW - ProjAuswertMatSEK").Range("A1")
        .Close False '不保存
    End With
    
    With Workbooks.Open(Filename:=Pfad & "Zeiten.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:H").Copy _
                wb.Worksheets("FW-PrjAuswertStunden").Range("A1")
        .Close False
    End With
    
    With Workbooks.Open(Filename:=Pfad & "Belege.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:H").Copy _
                wb.Worksheets("FW-Bestell-Lief-Pos").Range("A1")
        .Close False
    End With
    
End Sub
英文:

Try something like this:

Sub import_sheets()
    Const MAIN_FLD As String = "\\Server-Name\MainFolder\"
    
    Dim wb As Workbook, Pfad As String, ssf As String, dt As Date
    
    Set wb = ThisWorkbook 'if the same workbook as where the code is run
    With wb.Worksheets("info")    'for example; sheet with date/folder info
        dt = .Range("B1").Value   'date
        ssf = .Range("B2").Value  'sub-subfolder
    End With
    
    'build the path
    Pfad = MAIN_FLD & Format(dt, "yyy-mm-dd") & "\" & ssf & "\"
    
    With Workbooks.Open(Filename:=Pfad & "Kosten.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:L").Copy _
                wb.Worksheets("FW - ProjAuswertMatSEK").Range("A1")
        .Close False 'no save
    End With
    
    With Workbooks.Open(Filename:=Pfad & "Zeiten.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:H").Copy _
                wb.Worksheets("FW-PrjAuswertStunden").Range("A1")
        .Close False
    End With
    
    With Workbooks.Open(Filename:=Pfad & "Belege.xlsx", ReadOnly:=True)
        .Worksheets(1).Columns("A:H").Copy _
                wb.Worksheets("FW-Bestell-Lief-Pos").Range("A1")
        .Close False
    End With
    
End Sub

huangapple
  • 本文由 发表于 2023年4月4日 17:45:04
  • 转载请务必保留本文链接:https://go.coder-hub.com/75927882.html
匿名

发表评论

匿名网友

:?: :razz: :sad: :evil: :!: :smile: :oops: :grin: :eek: :shock: :???: :cool: :lol: :mad: :twisted: :roll: :wink: :idea: :arrow: :neutral: :cry: :mrgreen:

确定