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

uglyo_o
uglyo_o (10.385 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.375 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.385 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.385 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.385 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.385 point)
Ingen andre der har inputs :)?

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

uglyo_o
uglyo_o (10.385 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

Opslag i 2 tabeller med forskellige specifikationsgrader

Oprettet den 29. september 2014 kl. 15.22
mostermy giver 30 point for svar | Giv et svar »

Gå til - anden fane i samme regneark

Oprettet den 29. september 2014 kl. 15.07
Anders_D giver 30 point for svar | Giv et svar »

Kør PPT macro i Excel

Oprettet den 29. september 2014 kl. 13.33
MetteAa giver 30 point for svar | Giv et svar »






Computerworld

Teaser billede

Apple trækker iOS 8-opdatering tilbage - ødelægger iPhone

En splinterny opdatering til iOS 8 har udløst så mange klager, at Apple har trukket den tilbage igen.

CIO

Teaser billede

It-chefer kæmper med fortiden: Anses stadig mest som drifts-folk

De fleste it-chefer og CIO'er har for længst forstået, at it er nøglen til at skabe vækst og innovation i virksomheden. Desværre er det ikke nødvendigvis en erkendelse, man har i resten af...

Comon

Teaser billede

Android og iOS-kryptering får politiets alarmklokker til at ringe

Tendensen med at pakke brugernes smartphone-data ind i kryptering vækker bekymring hos politimyndigheder. De mener, at mange sager forbliver uløste, hvis ikke de kan få adgang til borgernes...

Channelworld

Teaser billede

Buldrer frem: Dustin er kongen af dansk online-salg

Den svenske online-koncern stormer frem i Danmark og sætter sig på to titler i årets udgave af Computerworlds Top 100.

White paper

Teaser billede

Sikkerhed og KVM-switching

Få svar på de sikkerhedsspørgsmål, der opstår ved brug af KVM-switche, og få strategier til at imødegå problemerne.



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