Skocz do zawartości


Close Open
Close Open
Zdjęcie
- - - - -

Import danych *.txt


  • Please log in to reply
6 replies to this topic

#1 lapbeer

lapbeer

    Początkujący

  • Forumowicze
  • PipPipPip
  • 62 Postów:

Napisany 17 June 2008 - 13:45 PM

Szukałem, szukałem i... jakoś nic nie znalazłem...
Proszę więc o pomoc. Zarejestrowałem nowe makro, które ma importować pliki *.txt. Wszystko działa ok. pod warunkiem, że importuję pliki o tej samej nazwie i z tej samej lokalizacji. Muszę jednak codziennie zaimportować nowy plik z nową nazwą (w nazwie jest aktualna data, np. dokumenty_17.06.08.txt - radzę sobie z tym w ten sposób, że usuwam datę z nazwy ale nie jest to dla mnie praktyczne).
I tu prośba o pomoc, jak zrobić, żebym mógł ręcznie wskazać plik txt do importu?

moje makro:

Sub Import()
'
' Import Makro
'
	
   'zapobiega "migotaniu" ekranu podczas wykonywania makra:
   Application.ScreenUpdating = False
   
	
	With ActiveSheet.QueryTables.Add(Connection:= _
		"TEXT;C:\Temp\dokumenty.txt" _
		, Destination:=Range("A1"))
		.Name = "dokumenty"
		.FieldNames = True
		.RowNumbers = False
		.FillAdjacentFormulas = False
		.PreserveFormatting = True
		.RefreshOnFileOpen = False
		.RefreshStyle = xlInsertDeleteCells
		.SavePassword = False
		.SaveData = True
		.AdjustColumnWidth = True
		.RefreshPeriod = 0
		.TextFilePromptOnRefresh = False
		.TextFilePlatform = 1250
		.TextFileStartRow = 5
		.TextFileParseType = xlDelimited
		.TextFileTextQualifier = xlTextQualifierDoubleQuote
		.TextFileConsecutiveDelimiter = False
		.TextFileTabDelimiter = False
		.TextFileSemicolonDelimiter = True
		.TextFileCommaDelimiter = False
		.TextFileSpaceDelimiter = False
		.TextFileColumnDataTypes = Array(1, 1)
		.TextFileTrailingMinusNumbers = True
		.Refresh BackgroundQuery:=False
	End With
	
End Sub

Z góry dziękuję za pomoc

#2 Mały_Rycho

Mały_Rycho

    eremita

  • Forumowicze
  • PipPipPipPipPipPipPip
  • 2014 Postów:
  • Płeć:Mężczyzna
  • Lokalizacja:Sulęcin

Napisany 17 June 2008 - 14:14 PM

Hej,
zobacz w pomocy opis metody Application.GetOpenFilename.
Mały Rycho

Jeśli mówisz prawdę, nie musisz niczego pamiętać. Mark Twain.

#3 lapbeer

lapbeer

    Początkujący

  • Forumowicze
  • PipPipPip
  • 62 Postów:

Napisany 18 June 2008 - 06:24 AM

znalazłem coś takiego:

ChDrive "C"
ChDir "C:\!temp"

plik = Application.GetOpenFilename(, , "Pokaż_plik", plik)

nie wiem tylko jak dodać to do mojego kodu, żeby import z założonymi warunkami został dokończony.

#4 jalamas

jalamas

    Bywalec

  • Forumowicze
  • PipPipPipPipPip
  • 322 Postów:

Napisany 18 June 2008 - 08:00 AM

Nie wiem czy chcesz usunąć potem to QueryTable, zakładam, że tak:

Option Explicit

Sub Test()
	Dim strFullName		 As String
	strFullName = TxtSelect()
	If Len(strFullName) = 0 Then
		MsgBox "Nie wybrano pliku !"
		Exit Sub
	End If
	Call QryImportTxt(ThisWorkbook.Worksheets("test"), strFullName)
End Sub

Function TxtSelect() As String
	Dim vrtSelectedItem	 As Variant
	With Application.FileDialog(msoFileDialogFilePicker)
		.AllowMultiSelect = False
		.Filters.Clear
		.Filters.Add "Pliki tekstowe", "*.txt"
		If .Show = -1 Then
			TxtSelect = .SelectedItems.Item(1)
		End If
	End With
End Function

Public Sub QryImportTxt(Wsh As Worksheet, _
						ByVal sFullName As String)
	On Error GoTo QryImportTxt_Error

	With Wsh
		.Cells.ClearContents
		With .QueryTables.Add(Connection:="TEXT;" & sFullName, _
							  Destination:=.Range("A1"))
			.Name = "jakies_1"		 ' tu dodajemy _liczba
			.FieldNames = True: .RowNumbers = False
			.FillAdjacentFormulas = False
			.PreserveFormatting = True: .RefreshOnFileOpen = False
			.RefreshStyle = xlInsertDeleteCells
			.SavePassword = False
			.SaveData = True
			.AdjustColumnWidth = True
			.RefreshPeriod = 0
			.TextFilePromptOnRefresh = False
			.TextFilePlatform = 1250
			.TextFileStartRow = 1
			' tu dopasuj do swojego pliku
			.TextFileParseType = xlDelimited
			.TextFileTextQualifier = xlTextQualifierDoubleQuote
			.TextFileConsecutiveDelimiter = False
			.TextFileTabDelimiter = True
			.TextFileSemicolonDelimiter = False
			.TextFileCommaDelimiter = False
			.TextFileSpaceDelimiter = False
			' ja mam akurat wiecej kolumn tu dopasuj pola- typy - ile do swojego pliku
			.TextFileColumnDataTypes = Array(xlYMDFormat, xlTextFormat, xlSkipColumn, xlSkipColumn, xlSkipColumn, xlSkipColumn)
			.TextFileTrailingMinusNumbers = True
			.Refresh BackgroundQuery:=False
		End With
	End With
	MsgBox "OK tutaj np <img src='https://forum.idg.pl/public/style_emoticons/<#EMO_DIR#>/excl.gif' class='bbc_emoticon' alt='!!' />!<img src='https://forum.idg.pl/public/style_emoticons/<#EMO_DIR#>/excl.gif' class='bbc_emoticon' alt='!!' />"
	
QryImportTxt_Exit:
	On Error Resume Next
	Call DeleteAllQueries(Wsh)
	Exit Sub

QryImportTxt_Error:
	MsgBox "Błąd : ( " & Err.Number & " ) " & Err.Description & vbCrLf & _
		   "Procedura  : " & "QryImportTxt", vbExclamation
	Resume QryImportTxt_Exit
End Sub

Public Sub DeleteAllQueries(Wsh As Worksheet)
	Dim i				   As Long
	Dim strQN			   As String
	On Error Resume Next
	With Wsh
		For i = .QueryTables.Count To 1 Step -1
			strQN = .QueryTables(i).Name
			.QueryTables(i).Delete
			.Names(strQN).Delete
		Next
	End With
End Sub
'----------------------------------------------------------


#5 lapbeer

lapbeer

    Początkujący

  • Forumowicze
  • PipPipPip
  • 62 Postów:

Napisany 18 June 2008 - 08:27 AM

coś w tym kodzie jest nie teges bo wywala błąd przy:

Call QryImportTxt(ThisWorkbook.Worksheets("test"), strFullName)


#6 jalamas

jalamas

    Bywalec

  • Forumowicze
  • PipPipPipPipPip
  • 322 Postów:

Napisany 18 June 2008 - 09:25 AM

Nie wiem co to za numer błędu "wywala błąd" ?, a czy masz w swoim skorszycie arkusz o nazwie test?

#7 lapbeer

lapbeer

    Początkujący

  • Forumowicze
  • PipPipPip
  • 62 Postów:

Napisany 18 June 2008 - 09:39 AM

Jalamas, wszystko działa!
Okazałem się VB-ignorantem... ;-)

Dzięki bardzo!




0 Użytkowników czyta ten temat

0 użytkowników, 0 gości, 0 anonimowych użytkowników