Új hozzászólás Aktív témák

• #14258 lappy őstag D@ni88 #14257

  Új Válasz 2012-07-05 15:02:05 #14258

  Új hozzászólás

  Összes hozzászólása itt Válaszok az összes hozzászólására itt Válaszok erre a hozzászólásra

  Privát üzenet küldése

  

  lappy

  őstag

  válasz D@ni88 #14257 üzenetére

  Szia!
  itt van egy txt beolvasó

  Public Sub ImportTextFile(FName As String, Sep As String)
  
  Dim RowNdx As Long
  Dim ColNdx As Integer
  Dim TempVal As Variant
  Dim WholeLine As String
  Dim Pos As Integer
  Dim NextPos As Integer
  Dim SaveColNdx As Integer
  
  Application.ScreenUpdating = False
  'On Error GoTo EndMacro:
  
  SaveColNdx = ActiveCell.Column
  RowNdx = ActiveCell.Row
  
  Open FName For Input Access Read As #1
  
  While Not EOF(1)
  Line Input #1, WholeLine
  If Right(WholeLine, 1) <> Sep Then
  WholeLine = WholeLine & Sep
  End If
  ColNdx = SaveColNdx
  Pos = 1
  NextPos = InStr(Pos, WholeLine, Sep)
  While NextPos >= 1
  TempVal = Mid(WholeLine, Pos, NextPos - Pos)
  Cells(RowNdx, ColNdx).Value = TempVal
  Pos = NextPos + 1
  ColNdx = ColNdx + 1
  NextPos = InStr(Pos, WholeLine, Sep)
  Wend
  RowNdx = RowNdx + 1
  Wend
  
  EndMacro:
  On Error GoTo 0
  Application.ScreenUpdating = True
  Close #1
  
  End Sub
  
  Sub DoTheImport()
  Dim FileName As Variant
  Dim Sep As String
  FileName = Application.GetOpenFilename(FileFilter:="Text File (*.txt),*.txt")
  If FileName = False Then
  ''''''''''''''''''''''''''
  ' user cancelled, get out
  ''''''''''''''''''''''''''
  Exit Sub
  End If
  Sep = Application.InputBox("Írjon be egy elválasztó karaktert.", Type:=2)
  If Sep = vbNullString Then
  ''''''''''''''''''''''''''
  ' user cancelled, get out
  ''''''''''''''''''''''''''
  Exit Sub
  End If
  Debug.Print "FileName: " & FileName, "Separator: " & Sep
  ImportTextFile FName:=CStr(FileName), Sep:=CStr(Sep)
  End Sub

  Bámulatos hol tart már a tudomány!

Új hozzászólás Aktív témák