Wie in den Threat zu., Dictionary: : https://vbasteleien.de/viewtopic.php?t=537
angekündigt, hier ein Spickzettel für das übertragen, abspeichern der Datensätze in einer Textdatei.
Code: Alles auswählen
'#################################################################################################################
'
' !!!!!! A T T E N T I O N !!!!!!
'
' Go to Tools -> References... and check "Microsoft Scripting Runtime" to be able to use the FileSystemObject
' The FileSystemObjectwhich has many useful features for handling files and folders
' ###### OR ######
' use this SubRoutine: Public Sub ActivateReferenceByGUID(strGUID As String, lngMajor As Long, lngMinor As Long)
' and call it with: ActivateReferenceByGUID "{0002E157-0000-0000-C000-000000000046}", 0, 0
' @source:
' by courtesey of: Thx to Chandoo, Francis and snb.
'
'
'#################################################################################################################
'
'
'----------------------------------------------------------------------------------------------------------------
'
' @purpose: populates, espectivley writes Data from an Excel-Range to the targeted Textfile. The extension
' (suffix) may ".txt" or ".csv"
' @params: strPath, The Full Path, including the FilieName and the Suffix,
' @author: thowe
' @deprecated: -
' @version: 0.0.1
'---------------------------------------------------------------------------------------------------------------
Sub WriteToTextFile(strPath As String, strSheetName As String, Optional bolHeader As Boolean = True)
Dim objTextFile As Object
Set objTextFile = OpenTextFile(strPath)
Dim rngData As Range
Dim r As Long 'Iterator for Rows in Range
Dim c As Long 'Iterator for Columns in Range
Dim strLineText As String 'Text to populate for each Row in Range
'initialize
'Set rngData = wksSystemInfos.Range("A1").CurrentRegion
Set rngData = ThisWorkbook.Worksheets(strSheetName).Range("A1").CurrentRegion
strLineText = ""
For r = 1 To rngData.Rows.Count
For c = 1 To rngData.Columns.Count
strLineText = IIf(c = 1, "", strLineText & ",") & rngData.Cells(r, c)
Next c
Debug.Print strLineText
WriteDataToTextFile objTextFile, strLineText
Next r
closeTextFile objTextFile
End Sub
'creates and returns the file object
Function OpenTextFile(strPathToTextFile) As Object
Dim fso As Object
'Set fso = CreateObject("Scripting.FileSystemObject")
Set fso = New Scripting.FileSystemObject
Dim objFile As Object
Set objFile = fso.CreateTextFile(strPathToTextFile)
Set OpenTextFile = objFile
Set fso = Nothing
End Function
' writes to the file object created above
Sub WriteDataToTextFile(objFile As Object, DataToWrite)
objFile.WriteLine DataToWrite
End Sub
' tidy up when finished
Sub closeTextFile(objFile As Object)
objFile.Close
Set objFile = Nothing
End Sub