Oprettet man. d. 19. november 2012 kl. 23:04:54

uglyo_o
uglyo_o (10.315 point. Point ude: 630)


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 :)!

Skrevet tir. d. 20. november 2012 kl. 09:27:07| #1

PBChristensen
PBChristensen (6.305 point)
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

Skrevet tir. d. 20. november 2012 kl. 12:20:25| #2

uglyo_o
uglyo_o (10.315 point)
Fra en undermappe ville heller ikke gøre noget.
Jeg ser på det når jeg kommer hjem, men takker for input :)

Skrevet tir. d. 20. november 2012 kl. 21:11:50| #3

uglyo_o
uglyo_o (10.315 point)
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

Skrevet tir. d. 20. november 2012 kl. 21:30:27| #4

uglyo_o
uglyo_o (10.315 point)
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. :)

Skrevet ons. d. 21. november 2012 kl. 15:05:06| #5

uglyo_o
uglyo_o (10.315 point)
Ingen andre der har inputs :)?

Skrevet tor. d. 22. november 2012 kl. 23:56:37| #6

uglyo_o
uglyo_o (10.315 point)
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. :)

Skrevet tir. d. 24. december 2013 kl. 17:35:42| #7


Skriv et indlæg




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

Log ind

   


Seneste spørgsmål

Makro navne - forklaring ??

Oprettet den 16. september 2014 kl. 14.38
petzel giver 200 point for svar | Giv et svar »

Makro starter anden makro i samme fil

Oprettet den 16. september 2014 kl. 13.31
petzel giver 200 point for svar | Giv et svar »

Vise indhold i excel ark udfra dropdown menu

Oprettet den 16. september 2014 kl. 11.08
narkona giver 30 point for svar | Giv et svar »






Computerworld

Teaser billede

TDC smider pris-bombe: Ubegrænset mobiltelefoni i 31 lande

For et fast månedligt beløb kan TDC's erhvervskunder tale frit i mobil i 31 forskellige lande.

CIO

Teaser billede

Store it-projekter: Sådan styrer du dem sikkert i mål

Hvilken projektform skal du vælge, og hvad er den bedste måde at lede it-projekter på? Her er ulemper og fordele ved de forskellige projektledelsesformer.

Comon

Teaser billede

TDC klar med iPhone 6 om to uger - men er tavs om antallet

Om få uger får danskerne adgang til de nye iPhones. Men der er uvished om, hvor mange telefoner der kommer til Danmark.

Channelworld

Teaser billede

Kommune droppede iPads: De var for billige - og for besværlige

En klar pædagogisk strategi og hensynet til det eksisterende it-setup fik lærere og politikere i Nordfyn Kommune til at dumpe iPads, da der skulle købes tablet-computere til eleverne - også selv om...

White paper

Teaser billede

Den lette vej fra legacy til SOA

Få med dette webcast fra BluePhoenix et teknisk overblik over, hvad en legacy-modernisering kan indebære, og hvad der bedst kan betale sig.



Udgiver · © 2014 Computerworld A/S · Hørkær 18 · 2730 Herlev · Tlf.: 77 300 300 · Fax: 77 300 301 · Brug af personoplysninger