uglyo_o Nybegynder
19. november 2012 - 23:04 Der er 6 kommentarer og
1 løsning

Hent data fra en .txt fil med VBA/Makro

Jeg skal bruge en kode der kan hente og indsætte det i excel.
Excel filen og .txt filen ligger i samme mappe.
Men kan lige ledes ligge på skrivebordet, som et andet sted.
Så jeg tænkte på om man kan lave en VBA/Makro kode der bare henter data når der dukker en .txt fil op i samme mappe som excel filen.
Gerne hvor med af selve .txt filen kan hedde noget forskelligt.
Er dette muligt?

Den jeg har fundet.
Den henter data fint. Men den skal bruge en "Sti" for af kunne finde det. fks. når man laver .bat fil kan man indtaste *.*.txt også fks. flytter den alle, eller åbner alle .txt filer.

Er der nogle bestemte tegn som kan gøre dette i VBA/Makro?


Sub ImportDelimitedText()
'Importerer teksten adskilt af sSepChar i sSourceFile til
'Range(sTargetAddress). Overskriver ældre data.
'Normalt vil denne procedure blive kaldt af en anden,
'som så samtidig videregiver info om tekstfilens navn
'og sti (sSourceFile), separatortegn (sSepChar) og evt.
'celleadressen (sTargetSddress), hvor teksten skal sættes ind.

Dim sDel As String * 1
Dim LineString As String
Dim sSourceFile As String
Dim sSepChar As String
Dim sTargetAddress As String
Dim rTargetCell As Range
Dim vTargetValues As Variant
Dim r As Long
Dim fLen As Long
Dim fn As Integer

On Error GoTo ErrorHandle

'Importfilen og dens placering
sSourceFile = "C:\Stien Til Filen"
'Separatortegn (delimiter)
sSepChar = ";"
'Startcelle for placering af data
sTargetAddress = "A1"

'sSourceFile eksisterer ikke
If Len(Dir(sSourceFile)) = 0 Then Exit Sub

'Identificerer delimiter
If UCase(sSepChar) = "TAB" Or UCase(sSepChar) = "T" Then
  sDel = Chr(9)
Else
  sDel = Left(sSepChar, 1)
End If

'Importér data
Worksheets(1).Activate

'Sætter startcellens adresse
Set rTargetCell = Range(sTargetAddress).Cells(1, 1)

'Sletter evt. gamle data
rTargetCell.CurrentRegion.Clear

On Error GoTo BeforeExit

'Får et frit nummer af operativsystemet
fn = FreeFile

'Åbner filen for input
Open sSourceFile For Input As #fn
On Error GoTo 0
fLen = LOF(fn)
r = 0
While Not EOF(fn)
  Line Input #fn, LineString
  'Kalder funktionen, som skal læse teksten.
  vTargetValues = ParseDelimitedString(LineString, sSepChar)
  'Skriver til celler
  UpdateCells rTargetCell.Offset(r, 0), vTargetValues
  r = r + 1
Wend

'Lukker tekstfilen
Close #fn

BeforeExit: 'Rydder op
Set rTargetCell = Nothing

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i ImportDelimitedText."
Resume BeforeExit
End Sub

Function ParseDelimitedString(InputString As String, _
sDel As String) As Variant
'Returnerer et variant array indeholdende hvert element
'i InputString adskilt af sDel.

Dim i As Integer, iCount As Integer
Dim sString As String, sChar As String * 1
Dim ResultArray() As Variant

On Error GoTo ErrorHandle

sString = ""
iCount = 0
For i = 1 To Len(InputString)
  sChar = Mid$(InputString, i, 1)
  If sChar = sDel Then
    iCount = iCount + 1
    ReDim Preserve ResultArray(1 To iCount)
    ResultArray(iCount) = sString
    sString = ""
  Else
    sString = sString & sChar
  End If
Next i
iCount = iCount + 1
ReDim Preserve ResultArray(1 To iCount)
ResultArray(iCount) = sString
ParseDelimitedString = ResultArray

Exit Function
ErrorHandle:
MsgBox Err.Description & " Fejl i funktionen ParseDelimitedString."
End Function

Sub UpdateCells(rTargetRange As Range, vTargetValues As Variant)
'Skriver indholdet i variablen vTargetValues
'til det aktive faneblad begyndende i rTargetRange.
'Eksisterende data overskrives.

Dim r As Long, c As Integer

On Error GoTo ErrorHandle

If TypeName(ActiveSheet) <> "Worksheet" Then Exit Sub
r = 1
c = 1

On Error Resume Next

c = UBound(vTargetValues, 1)
r = UBound(vTargetValues, 2)
Range(rTargetRange.Cells(1, 1), rTargetRange.Cells(1, 1). _
Offset(r - 1, c - 1)).Formula = vTargetValues

Exit Sub
ErrorHandle:
MsgBox Err.Description & " Fejl i UpdateCells."
End Sub

Jeg takker på forhånd :)!
PBChristensen Nybegynder
20. november 2012 - 09:27 #1
Hej,

Kan ikke hjælpe dig med automatisk at hente data, men det kan være, at dette kan hjælpe med sti-problemet.

Her henter den data fra en undermappe (Data), men det kan du bare undlade:

Sub Read()
    Dim myPath As String
        myPath = ActiveWorkbook.Path
    Dim fnavn As String
    Dim strPath As String
    Dim strFileName As String
'Udskift stien med den ønskede sti
If Len(Dir(myPath & "\Data\", vbDirectory)) = 0 Then
    MkDir myPath & "\Data\"
End If
strPath = myPath & "\Data\"

    Application.DisplayAlerts = False
ChDir (strPath)
  Dim sFile As String
  Dim sText1 As String, sText2 As String, sText3 As String, sText4 As String, sText5 As String, sText6 As String, _
  sText7 As String, sText8 As String, sText10 As Currency, sText11 As Currency
  Dim iFilenum As Integer

  sFile = strPath & "Data.txt"

  iFilenum = FreeFile
  Open sFile For Input As iFilenum
  Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, sText10, sText11
  Close #iFilenum
Range("A1") = sText1
Range("B1") = sText2
Range("C1") = sText3
Range("D1") = sText4
Range("E1") = sText5
Range("F1") = sText6
Range("G1") = sText7
Range("H1") = sText8
Range("I1") = sText10
Range("J1") = sText11
End Sub
uglyo_o Nybegynder
20. november 2012 - 12:20 #2
Fra en undermappe ville heller ikke gøre noget.
Jeg ser på det når jeg kommer hjem, men takker for input :)
uglyo_o Nybegynder
20. november 2012 - 21:11 #3
Får fejl ved:

Input #iFilenum, sText1, sText2, sText3, sText4, sText5, sText6, sText7, sText8, sText10, sText11

Run-time error '62':
input past end of file
uglyo_o Nybegynder
20. november 2012 - 21:30 #4
Har fundet ud af det,
Det står for hver ligne.
Kan godt bruge af den har en under mappe.
den finder filen ved bestemt navn i undermappen.

men kunne være godt hvis man kunne få den til af læse nyeste fil via. jo højere tal. fks. Update V. 1.0.0
Og så af den poster fra start A1 og til der ikke er flere ligner i excel filen, hvor med den os springer tomme ligner ovre i .txt filen.

og af det måske var automatisk,
men prøver af se om andre har input, ellers må jeg evt. prøve af lege med den du postede. :)
uglyo_o Nybegynder
21. november 2012 - 15:05 #5
Ingen andre der har inputs :)?
uglyo_o Nybegynder
22. november 2012 - 23:56 #6
Hvis det ikke er muligt,
kan man så fks. skrive i en kolone, fks. D1:D20
om hvilke navne filen kunne hedde, & dermed går VBA koden først ind og søger idette punkt D1:D20 og finder det, og dermed henter data i excel.

fks. i kolone D1:D20 filerne kan komme til af hedde.

Update V. 1.0.0
Update V. 1.0.1
Update V. 1.0.2
Update V. 1.0.3
Update V. 1.0.4
Update V. 1.0.5
Update V. 1.0.6
Update V. 1.0.7
Update V. 1.0.8
Update V. 1.0.9
Update V. 1.1.0
Update V. 1.1.1

Så hvis man putter update v. 1.0.0 vil den vælge den.
Men hvis der kommer en fil der hedder update v. 1.0.6 skal den tage den.
Men kommer der fks. en der ikke står i kolonen, så skal den komme op med en fejl. :)
uglyo_o Nybegynder
24. december 2013 - 17:35 #7
Lukker.
Ny bruger Nybegynder

Din løsning...

Tilladte BB-code-tags: [b]fed[/b] [i]kursiv[/i] [u]understreget[/u] Web- og emailadresser omdannes automatisk til links

Opret Preview

Log ind eller opret profil

Hov!

For at kunne deltage på Computerworld Eksperten skal du være logget ind.

Det er heldigvis nemt at oprette en bruger: Det tager to minutter og du kan vælge at bruge enten e-mail, Facebook eller Google som login.

Du kan også logge ind via nedenstående tjenester





Computerworld
Dansk sikkerhedsfirma slår alarm: "Jeg har fundet et atomkraftværk, hvor man kunne hæve strålingsniveauet og et fængsel, hvor fængselsdørene kan åbnes fra en server"
Dansk sikkerhedsfirma finder hidtil ukendt fejl, der kan udløse en katastrofe, hvis data havner i de forkerte hænder. Men der findes en løsning.
CIO
CIO i Energinet.dk: Sådan får vi bedre it-sikkerhed hos danske energiselskaber
Interview: Morten Gade Christensen, CIO i Energinet.dk og Årets CIO i Danmark i 2016, har en klar idé om, hvordan den danske energisektor kan få et bedre sikkerhedsniveau.
Comon
25.000 danskere gået i kuponsvindel-fælde på Facebook på blot seks timer: "Det spredte sig som en steppebrand"
Fakta, Netto, Aldi, Lidl, Lego og flere andre varemærker bliver lige nu udnyttet i forbindelse med kuponsvindel på Facebook, og danskerne klikker i hobetal. Læs hvad der sker, hvis du klikker.
Channelworld
Dansk hosting-direktør: På disse tre områder banker danske hosting-firmaer Microsoft og Amazon af banen
Den danske hostingbranche er godt polstret til at modstå konkurrencen fra globale cloud-spillere som Amazon og Microsoft. Her er tre grunde til, at danske hostingudbydere ikke blæser omkuld i konkurrencen.
White paper
Mobility - her er de aktuelle udfordringer
Hvad med sikkerheden? Mobility-bølgen fejer igennem danske virksomheder, og der er masser af muligheder og faldgruber. Sikkerheden halter, men det kan der gøres noget ved. Produceret af Computerworld.dk i oktober 2014.