EulumDat File open in Excel.

[Noord2011]

Bekijk bijlage File.zipBeste mensen,


Om bepaalde info te krijgen vanuit EulumDat files wil in Bekijk bijlage EDF Filter.xlseen Excel bestaand maken incl. filter.

D.m.v. de Knop invoegen wil ik alle EulumDat file in de map invoegen en vervolgens filteren. Varieert van 10 tot 60 EulumDat file in een map.

De ingevoegde EulumDat file komen in de Sheet EulumDat File en vervolgens worden alleen de gele rijen als filter in de sheet EulumDat file gepresenteerd.

Zie bijlage Excel en Zip met daarin EulumDat Files

Wie kan me helpen?

Alvast bedankt!

 

[hoogteijling]

Kan je er niet komen door de Excel macrorecorder te gebruiken en vervolgens in de VBA editor de code aan te passen ?
Het is me ook niet helemaal duidelijk hoe het resultaat er precies uit moet komen te zien.

Groeten Marcel

 

[Noord2011]

Het bedoeling is met de knop alle Eulumdat file die in de geselecteerde map is ingevoegd worden in de Excel bestand, vervolgen filter toegevoegd.

Mijn probleem begin bij het invoegen van de Eulumdat file, hoe krijg ik ze allemaal ingevoegd in de Excel bestaand naast of onder elkaar.

Iemand een idee???

 

[Noord2011]

Ik heb wat aan elkaar geplaakt kan iemand verder mee?

Sub GetOpenFileNameExample5()

  sPath = "C:\"
  st = Application.GetOpenFilename("text files (*.*),*.*", , "Bestandsselectie", , True)
  If TypeName(st) = "Boolean" Then Exit Sub
  
  'voor een file:
 ' With ActiveSheet.QueryTables.Add("TEXT;" & st(1), Range("A3"))
  
  'voor meerdere files onderelkaar:
   With ActiveSheet.QueryTables.Add("TEXT;" & st(1), Range("A" & Rows.Count).End(xlUp).Offset(2))
    
    .Name = st(1)
    .FieldNames = True
    .RowNumbers = False
    .FillAdjacentFormulas = False
    .PreserveFormatting = True
    .RefreshOnFileOpen = False
    .RefreshStyle = xlInsertDeleteCells
    .SavePassword = False
    .SaveData = True
    .AdjustColumnWidth = True
    .RefreshPeriod = 0
    .TextFilePromptOnRefresh = False
    .TextFilePlatform = xlMSDOS
    .TextFileStartRow = 1
    .TextFileParseType = xlDelimited
    .TextFileTextQualifier = xlTextQualifierDoubleQuote
    .TextFileConsecutiveDelimiter = True
    .TextFileTabDelimiter = True
    .TextFileSemicolonDelimiter = False
    .TextFileCommaDelimiter = False
    .TextFileSpaceDelimiter = True
    .Refresh BackgroundQuery:=False
  End With
End Sub

 

[RaymondC]

http://www.worksheet.nl/forumexcel/vragen/69182-div-bestanden-samenvoegen-tot-1-excel-2007-a.html

misschien dat je met bovenstaande iets kan?

 

[Noord2011]

Kan iemand me verder helpen

Sub test()
    Dim myDir As String, fn As String, ff As Integer, txt As String
    Dim delim As String, n As Long, b(), flg As Boolean, x, t As Integer
    'sPath = "C:\test"
    myDir = "c:\test" '<- change to actual folder path
    'delim = vbTab '<- delimiter (assuming Tab delimited)
   fn = Dir(myDir & "\*.*")
    Do While fn <> ""
        ReDim b(1 To Rows.Count, 1 To 1)
        ff = FreeFile
        Open myDir & "\" & fn For Input As #ff
        Do While Not EOF(ff)
            Line Input #ff, txt
            x = Split(txt, delim)
            If Not flg Then
                n = n + 1: b(n, 1) = fn
            End If
            If UBound(x) > 0 Then
                n = n + 1
                b(n, 1) = x(1)
            End If
            flg = True
        Loop
        Close #ff
        flg = False
        t = t + 1
        ThisWorkbook.Sheets(1).Cells(1, t).Resize(n).Value = b
        n = 0
        fn = Dir()
    Loop
End Sub

Alleen de rest van de Eulumdat file dient ingevuld worden, de bestaand naam worden in rij 1 ingevuld. Elke bestand in een apparte rij.

 

[Noord2011]

Nog een poging

Sub Import2NextCol() 
     
    Dim Filt$, Title$, FileText$ 
    Dim FileName$, N&, FirstEmpty& 
     
     '//show dialog to import file
     '{Note: Office 2000 requires that
     '(*.bas; *.frm; *.cls;*.txt;*.log;*.frx)
     'be written twice, for later versions you
     'can delete the second instance}
    Filt = "VB Files (*.bas; *.frm; *.cls;*.txt;*.log;*.frx) " & _ 
    "(*.bas; *.frm; *.cls;*.txt;*.log;*.frx)," & _ 
    "*.bas;*.frm;*.cls;*.txt;*.log;*.frx" 
    Title = "SELECT A FOLDER - DOUBLE-CLICK OR CLICK " & _ 
    "OPEN TO IMPORT - CANCEL TO QUIT" 
    FileName = Application.GetOpenFilename _ 
    (FileFilter:=Filt, FilterIndex:=5, Title:=Title) 
     
     '//find first empty column
    On Error Goto IsBlankSheet '< Error = nothing to find
    FirstEmpty = Cells.Find("*", SearchOrder:=xlByColumns, _ 
    LookIn:=xlValues, SearchDirection:=xlPrevious). _ 
    Column + 1 
     
     '//all columns contain text
    If FirstEmpty = 257 Then 
        MsgBox "Sorry, no more columns on this sheet" 
        Exit Sub 
    End If 
     
TextEntry: 
     '//check there is a file to import
    If Dir(FileName) <> Empty Then 
         '//import the text
        Application.ScreenUpdating = False 
        Open (FileName) For Input As #1 
        N = 1 
        Do While Not EOF(1) 
            Input #1, FileText 
            Rows(N).Columns(FirstEmpty) = FileText 
            N = N + 1 
        Loop '< Loop until end of file
        Close #1 
         
         '//tart up the spreadsheet
        ActiveWindow.DisplayGridlines = False 
        With Cells 
            .Font.Size = 9 
            Columns.AutoFit 
            Rows.AutoFit 
        End With 
         
         '//goto the start of the entered text & exit sub
        Application.Goto Rows(1).Columns(FirstEmpty), scroll:=True 
    End If 
    Exit Sub 
     
IsBlankSheet: 
     '//start in column 1
    FirstEmpty = 1 
     '//clear the error & continue import
    Resume TextEntry

Wie weet

 

[Noord2011]

Beste mensen,

Ik een stapje verder gekomen, alleen worden ze onder elkaar ingevoegd. Wie kan met helpen voor naast elkaar invoegen.

Sub Macro1()
 Dim Row As Integer
 Dim ws As Worksheet
 Set ws = ActiveWorkbook.Sheets("Blad1")
  
sPath = "C:\"

  st = Application.GetOpenFilename("text files (*.*),*.*", , "Bestandsselectie", , True)
  If TypeName(st) = "Boolean" Then Exit Sub
    
      For Row = 1 To 5
        With ActiveSheet.QueryTables.Add("TEXT;" & st(1), Range("A" & Rows.Count).End(xlUp).Offset(2))
        .Name = "inser1 - kopie_1"
        .FieldNames = True
        .RowNumbers = False
        .FillAdjacentFormulas = False
        .PreserveFormatting = True
        .RefreshOnFileOpen = False
        .RefreshStyle = xlInsertDeleteCells
        .SavePassword = False
        .SaveData = True
        .AdjustColumnWidth = True
        .RefreshPeriod = 0
        .TextFilePromptOnRefresh = False
        .TextFilePlatform = 850
        .TextFileStartRow = 1
        .TextFileParseType = xlDelimited
        .TextFileTextQualifier = xlTextQualifierDoubleQuote
        .TextFileConsecutiveDelimiter = False
        .TextFileTabDelimiter = True
        .TextFileSemicolonDelimiter = False
        .TextFileCommaDelimiter = False
        .TextFileSpaceDelimiter = False
        .TextFileColumnDataTypes = Array(1)
        .TextFileTrailingMinusNumbers = True
        .Refresh BackgroundQuery:=False

    End With
   Next Row
End Sub

 

[Noord2011]

Ik ben zo ver gekomen!

Alleen moet nog de Path varibel zijn

Zie code

Private Sub CommandButton1_Click()
Dim myDir As String, fn As String, ff As Integer, txt As String
Dim delim As String, n As Long, b(), flg As Boolean, x, t As Integer
Dim r As Integer, c As Integer
Dim FName As Variant


myDir = "c:\test" '< variabel, elke keer een ander map
delim = " "
fn = Dir(myDir & "\*.*")
c = 1
Do While fn <> ""
c = c + 1
r = 1
ff = FreeFile
Open myDir & "\" & fn For Input As #ff
Do While Not EOF(ff)
Line Input #ff, txt
ThisWorkbook.Sheets(1).Cells(r, c) = txt
r = r + 1
Loop
Close #ff
fn = Dir()
Loop
  Application.CutCopyMode = False
Macro1
MsgBox "Klaar met ingeladen"
End Sub

Wie kan me verder helpen?

 

[EulumdatTools]

Waarom inlezen in Excel, gebruik EulumdatTools voor verwerking

Heel lang geleden hen ik ook macros gemaakt om Eulumdat files in te lezen in excel. Dit had te maken met zaken als noodverlichtingsberekeningen (maximum spatiering voor verlichtingssterkte 1 lux op midden gang).
Hoewel Excel veel kan, is het verre van ideaal voor file manipulatie. Ik had dan ook constant problemen die te maken hadden met line endings, character encoding (rare karakters), Excel die cijfers wil maken van alles wat een cijfer is, ook als het een tekstveld moet blijven etcetera.

Wil je grote hoeveelheden EULUMDAT files editen, managen en doorzoeken, dan adviseer ik je om eens te kijken naar EulumdatTools, een workbench voor het beheren van grote hoeveelheden EULUMDAT files. Je krijgt dan ook conversie van en naar IES, lampen controle en een speciale EULUMDAT editor cadeau. 30 dagen gratis evaluatie license, kijk op http://www.fold1.com/eulumdattools/ of [video]http://youtu.be/FKaNMdOuUw0[/video]