Speichern, Tabs raus, Konvertieren

'//Safe the Import As TextFile Private Sub SafeAsText() Dim workbook_ As Workbook Dim wbPath As String Application.DisplayAlerts = False Set workbook_ = Workbooks.Add ThisWorkbook.Sheets(1).Copy After:=workbook_.Sheets(1) workbook_.Sheets(1).Delete workbook_.WebOptions.Encoding = msoEncodingUSASCII workbook_.SaveAs Filename:=DefaultPath & Mid(SplitCsvName, 1, Len(SplitCsvName) - 4), _ FileFormat:=xlText wbPath = workbook_.FullName workbook_.Close False Application.DisplayAlerts = True EraseTabulator wbPath End Sub '//Replace Tab with 1-Spacebar hit and convert to .dat Private Sub EraseTabulator(ByVal file_ As Variant) Dim data_ As String Dim newData As String Dim free_ As Long free_ = FreeFile Open file_ For Input As #free_ Do Until EOF(free_) Line Input #free_, data_ data_ = Replace(data_, vbTab, " ", , , vbTextCompare) newData = newData & data_ & vbCrLf Loop Close #free_ free_ = FreeFile Open file_ For Output As #free_ Print #free_, newData Close #free_ Name file_ As Mid(file_, 1, Len(file_) - 4) & ".dat" End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub Makro1() 'CSV importieren --> Werte bearbeiten ERLEDIGT! '--> als txt Speichern JETZT! Dim oWB As Workbook Dim rngRw As Range For Each oWB In Workbooks If Right(oWB.Name, 4) = ".csv" Then Exit For Next oWB If oWB Is Nothing Then Exit Sub Open "E:\Temp\Test.txt" For Output As #1 For Each rngRw In oWB.Sheets(1).UsedRange.Rows Print #1, Join(Application.Transpose(Application.Transpose(rngRw.Value)), " ") Next rngRw Close #1 End Sub

Hallo Leute,
nochmal ein Dankeschön an fkw48.
Code macht folgendes:
- Lass Nutzer eine CSV-Datei auswählen
- Importiere die Daten
- Speichere das Worksheet mit den Daten als .dat
(Mein original Code bearbeitet noch die Daten, die Prozeduren dafür
sind aber unwichtig für jeden außer mir)
Code:

Option Explicit
'	Module wide Variables
Private worksheet_ As Worksheet
Private DefaultPath As String
Private TmpPath As String
Private csv_ As String
'	Can be Called from outside
'	Executes the below Code for
'	importing csv and saving it as .dat
Public Sub Import()
DefaultPath = Environ("Userprofile") & "\Documents\"
TmpPath = DefaultPath & "tmp_.txt"
Set worksheet_ = ThisWorkbook.Sheets(1)
worksheet_.UsedRange.Clear
'//Select File
csv_ = CsvFilePath
If csv_ = "" Then Exit Sub
'//Import the Data
AddCSV
'//Safe File as Dat
CreateDatFile
'//Clear Connection To imported File
ClearConnections
End Sub
'	Let User select file
Private Function CsvFilePath() As String
Dim FileDialog_ As FileDialog
Dim selection_
Set FileDialog_ = Application.FileDialog(msoFileDialogFilePicker)
With FileDialog_
.Filters.Add "CSV", "*.csv", 1
.AllowMultiSelect = False
.InitialFileName = DefaultPath
If .Show = -1 Then
For Each selection_ In .SelectedItems
CsvFilePath = selection_
Next selection_
End If
End With
Set FileDialog_ = Nothing
End Function
'	Import the csv File
'	This code comes from the
'	macro recorder
Private Sub AddCSV()
With worksheet_.QueryTables.Add(Connection:="TEXT;" & csv_, _
Destination:=Range("A1"))
.FieldNames = True
.RowNumbers = False
.FillAdjacentFormulas = False
.PreserveFormatting = False
.RefreshOnFileOpen = False
.RefreshStyle = xlInsertDeleteCells
.SavePassword = False
.SaveData = True
.AdjustColumnWidth = False
.RefreshPeriod = 0
.TextFilePromptOnRefresh = False
.TextFilePlatform = xlMSDOS
.TextFileStartRow = 1
.TextFileParseType = xlDelimited
.TextFileTextQualifier = xlTextQualifierDoubleQuote
.TextFileConsecutiveDelimiter = False
.TextFileTabDelimiter = False
.TextFileSemicolonDelimiter = False
.TextFileCommaDelimiter = True
.TextFileSpaceDelimiter = True
.TextFileColumnDataTypes = Array(1)
.TextFileTrailingMinusNumbers = True
.Refresh BackgroundQuery:=False
End With
End Sub
'	Extract the csv File Name
Private Function SplitCsvName() As String
Dim array_() As String
array_ = Split(csv_, "\")
SplitCsvName = array_(UBound(array_))
Erase array_
End Function
'	Write Sheet Values in Tmp File and Save it as .dat
Private Sub CreateDatFile()
Dim splittedName As String
Dim workbook_ As Workbook
Dim rng As Range
Dim file_ As Long
'//Get the Name of the csv File
splittedName = SplitCsvName
'//Check if Tmp File Exists, if not then Create it
If Dir(TmpPath, vbDirectory) = vbNullString Then CreateTmpFile
file_ = FreeFile
Open TmpPath For Output As #file_
Set workbook_ = ThisWorkbook
For Each rng In workbook_.Sheets(1).UsedRange.Rows
Print #file_, Join(Application.Transpose(Application.Transpose(rng.Value)), " ")
Next rng
Close #file_
Name TmpPath As DefaultPath & Mid(splittedName, 1, Len(splittedName) - 4) & ".dat"
Set workbook_ = Nothing
End Sub
'	If the tmp File doenst exist then create it
Private Sub CreateTmpFile()
Dim fso As Object
Dim file_ As Object
Set fso = CreateObject("Scripting.FileSystemObject")
Set file_ = fso.CreateTextFile(TmpPath)
file_.Close
Set file_ = Nothing
Set fso = Nothing
End Sub
'	Delete Connection(s) that where added by Sub: AddCsv
Private Sub ClearConnections()
Dim varConnection As Variant
For Each varConnection In ThisWorkbook.Connections
varConnection.Delete
Next varConnection
End Sub

Beliebteste Forumthreads (12 Monate)

Speichern, Tabs raus, Konvertieren

3 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

3
Beiträge zum Forumthread

Beiträge zu diesem Forumthread