Import sešitu pomocí předem určeného adresáře a jméno našel v cele

Question 1

I v současné době dovozní listy dat do aplikace excel, že jsem export z CAD. To zahrnuje souhrny, obrazu a jiných dat. Chtěl bych přidat do kódu tak, že to bude importovat soubor z daného adresáře C:\Jobs\packlist a pomocí číslo uvnitř buňky ='PL CALC'!B1 (to určí název souboru). Myšlenka je odstranit dialogové okno otevřít a zvýšení automatizace.

To je to, co jsem zjistil, že funguje dosud. To otevře vybraný soubor a zkopíruje jej do sešitu po listu 18.

'import excel data sheet

Sub import()

Dim fName As String, wb As Workbook

'where to look for the framecad excel file

ChDrive "C:"
ChDir "C:\Jobs\packlist"

fName = Application.GetOpenFilename("Excel Files (*.xl*), *.xl*")
Set wb = Workbooks.Open(fName)
    For Each sh In wb.Sheets
            Sheets.Copy After:=ThisWorkbook.Sheets(18)
            Exit For
            Next
    wb.Close False      
    Worksheets("PL CALC").Activate

End Sub

Question 2

Dovozní Listy

Option Explicit

Sub ImportSheets()
    Const ProcTitle As String = "Import Sheets"

    Const sFolderPath As String = "C:\Jobs\packlist\"
    Const sfnAddress As String = "B1"
    Const sFileExtensionPattern As String = ".xls*"
    
    Const dwsName As String = "PL CALC"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    
    Dim sFilePattern As String: sFilePattern = sFolderPath & "*" _
        & dws.Range(sfnAddress).Value & sFileExtensionPattern
    
    Dim sFileName As String: sFileName = Dir(sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No file found..." & vbLf & "'" & sFilePattern & "'", _
            vbCritical, ProcTitle
        Exit Sub
    End If

    Application.ScreenUpdating = False
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFolderPath & sFileName)
        
    Dim sh As Object
        
    For Each sh In swb.Sheets
        sh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
    Next sh
    
    swb.Close SaveChanges:=False
    
    dws.Activate
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets imported.", vbInformation, ProcTitle
    
End Sub

VBasic2008 · Answer 1 · 2021-11-23T12:17:58

Dovozní Listy

Option Explicit

Sub ImportSheets()
    Const ProcTitle As String = "Import Sheets"

    Const sFolderPath As String = "C:\Jobs\packlist\"
    Const sfnAddress As String = "B1"
    Const sFileExtensionPattern As String = ".xls*"
    
    Const dwsName As String = "PL CALC"
    
    Dim dwb As Workbook: Set dwb = ThisWorkbook ' workbook containing this code
    Dim dws As Worksheet: Set dws = dwb.Worksheets(dwsName)
    
    Dim sFilePattern As String: sFilePattern = sFolderPath & "*" _
        & dws.Range(sfnAddress).Value & sFileExtensionPattern
    
    Dim sFileName As String: sFileName = Dir(sFilePattern)
    If Len(sFileName) = 0 Then
        MsgBox "No file found..." & vbLf & "'" & sFilePattern & "'", _
            vbCritical, ProcTitle
        Exit Sub
    End If

    Application.ScreenUpdating = False
    
    Dim swb As Workbook: Set swb = Workbooks.Open(sFolderPath & sFileName)
        
    Dim sh As Object
        
    For Each sh In swb.Sheets
        sh.Copy After:=dwb.Sheets(dwb.Sheets.Count)
    Next sh
    
    swb.Close SaveChanges:=False
    
    dws.Activate
    'dwb.Save
    
    Application.ScreenUpdating = True
    
    MsgBox "Sheets imported.", vbInformation, ProcTitle
    
End Sub

Import sešitu pomocí předem určeného adresáře a jméno našel v cele

Otázka

Nejlepší odpověď

Dovozní Listy

V jiných jazycích

Tato stránka je v jiných jazycích

Populární v této kategorii

Oblíbené položky v této kategorii