Variabeler Speicherort der export datei
24.02.2015 11:14:18
Marc
ich habe ein problem!
Durch Rudis hilfe habe ich dieses Makro erstellt.
Ich speichere die exportierten Dateien auf einem Netzwerk Laufwerk Z: ich möchte jedoch wenn dieses nicht erreichbar ist also kein Netzwerkzugriff herrscht das die exportierte Datei auf dem Desktop des jeweiligen Pc´s hinterlegt wird.
Ich habe es mit einer If Funktion versucht aber das klappte leider nicht.
Hoffentlich könnt ihr mir helfen!
Viele Grüße Marc
Sub StelleAutoFilterEin()
Dim pfad As String
Dim Wert1 As String
Dim Wert2 As String
Dim Datum As String
Dim strCSV As String
Const Unterstrich = "_"
Selection.AutoFilter Field:=1, Criteria1:="x"
Application.ScreenUpdating = False
ActiveSheet.Unprotect
Range("A1:S1000").Copy
Workbooks.Add
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:= _
True, Transpose:=False
Selection.PasteSpecial Paste:=xlPasteComments, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Columns("A:S").AutoFit
strCSV = CreateCsvText(Range("A1").CurrentRegion)
pfad = "Z:\Messung\Messstellenplan\Csv Export"
Wert1 = InputBox("Bitte Maschine eingebn")
Wert2 = InputBox("Bitte Seriennummer eingebn")
Datum = Format(Date, "yyyymmdd")
Open pfad & Datum & Unterstrich & Wert1 & Unterstrich & Wert2 & _
Unterstrich & "Messstellenplan.csv" For Output As #1
Print #1, strCSV
Close #1
ActiveWorkbook.Save
End Sub
Function CreateCsvText(rng As Range)
Dim lngRow As Long
Dim vntArray As Variant
Dim strText As String
Const strSep As String = ";"
With rng
For lngRow = 1 To .Rows.Count
vntArray = .Cells(lngRow, 1).Resize(, .Columns.Count)
vntArray = WorksheetFunction.Transpose(WorksheetFunction.Transpose(vntArray))
If strText = "" Then
strText = Join(vntArray, strSep)
Else
strText = strText _
& vbCrLf _
& Join(vntArray, strSep)
End If
Next
End With
CreateCsvText = strText
End Function