Option Explicit
Sub ExportDateloenTilMultiLoen()
Dim AppName As String
ExportRow 2, -999
ExportRowFra 2, -999
'ExportRow -999, -999
MsgBox "Færdig"
End Sub
Sub ExportRow(rStart As Long, rEnd As Long)
'assumes export from active sheet'
Dim ws As Worksheet, sTmp As String, sComma As String, sX As String
Dim colOutput As Collection, lRow As Long, iCol, colFail As String, colFail01 As String, colFail02 As String
Dim intNum As Integer
Dim sFileCSV As String, lfn As Long
Set colOutput = New Collection 'hold list of columns to output
colOutput.Add Item:="A" 'after:=0
colOutput.Add Item:="B" 'after:=0
colOutput.Add Item:="C" 'after:=0
colOutput.Add Item:="D" 'after:=0
colOutput.Add Item:="E" 'after:=0
colOutput.Add Item:="F" 'after:=0
colOutput.Add Item:="G" 'after:=0
colOutput.Add Item:="H" 'after:=0
colOutput.Add Item:="I" 'after:=0
colOutput.Add Item:="J" 'after:=0
colOutput.Add Item:="K" 'after:=0
colFail = "D"
colFail01 = "I"
colFail02 = "G"
'sFileCSV = "P:\danwin\export\MLAlm.csv"
sFileCSV = "Z:\$Kunder\FrontZ\Løn ark\MLAlm.csv"
'as dont want quotes, need to use print# and build the string'
sComma = ";" 'surround with spaces ?'
Set ws = ActiveSheet
'test for special input'
If rEnd = -999 Then
rEnd = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1
End If
If rStart = -999 Then
rStart = ws.UsedRange.Row
End If
sTmp = ""
lfn = FreeFile
Open sFileCSV For Output As lfn
For lRow = rStart To rEnd
For iCol = 1 To colOutput.Count
sX = colOutput.Item(iCol) & Format(lRow, "#0")
If ws.Range(sX).Value = "0" And colOutput.Item(iCol) = colFail Then
'row failure'
sTmp = ""
Exit For
End If
If ws.Range(sX).Value = "0" And colOutput.Item(iCol) = colFail01 Then
'row failure'
sTmp = ""
Exit For
End If
If colOutput.Item(iCol) = colFail02 Then
If CInt(ws.Range(sX).Value) <= 99 Then
'row failure'
sTmp = ""
Exit For
End If
End If
If iCol = 1 Then
sTmp = ws.Range(sX)
Else
sTmp = sTmp & sComma & ws.Range(sX)
End If
Next iCol
If sTmp <> "" Then
Print #lfn, sTmp
End If
Next lRow
Close lfn
End Sub
'''''''
Sub ExportRowFra(rStart As Long, rEnd As Long)
'assumes export from active sheet'
Dim ws As Worksheet, sTmp As String, sComma As String, sX As String
Dim colOutput As Collection, lRow As Long, iCol, colFail As String, colFail01 As String, colFail02 As String
Dim intNum As Integer
Dim sFileCSV As String, lfn As Long
Set colOutput = New Collection 'hold list of columns to output
colOutput.Add Item:="A" 'after:=0
colOutput.Add Item:="B" 'after:=0
colOutput.Add Item:="L" 'after:=0
colOutput.Add Item:="D" 'after:=0
colOutput.Add Item:="E" 'after:=0
colOutput.Add Item:="F" 'after:=0
colOutput.Add Item:="G" 'after:=0
colOutput.Add Item:="H" 'after:=0
colOutput.Add Item:="I" 'after:=0
colOutput.Add Item:="J" 'after:=0
colOutput.Add Item:="K" 'after:=0
colFail = "D"
colFail01 = "I"
colFail02 = "G"
'sFileCSV = "P:\danwin\export\MLFraVaer.csv"
sFileCSV = "Z:\$Kunder\FrontZ\Løn ark\MLFraVaer.csv"
'as dont want quotes, need to use print# and build the string'
sComma = ";" 'surround with spaces ?'
Set ws = ActiveSheet
'test for special input'
If rEnd = -999 Then
rEnd = ws.UsedRange.Rows.Count + ws.UsedRange.Row - 1
End If
If rStart = -999 Then
rStart = ws.UsedRange.Row
End If
sTmp = ""
lfn = FreeFile
Open sFileCSV For Output As lfn
For lRow = rStart To rEnd
For iCol = 1 To colOutput.Count
sX = colOutput.Item(iCol) & Format(lRow, "#0")
If ws.Range(sX).Value = "0" And colOutput.Item(iCol) = colFail Then
'row failure'
sTmp = ""
Exit For
End If
If ws.Range(sX).Value = "0" And colOutput.Item(iCol) = colFail01 Then
'row failure'
sTmp = ""
Exit For
End If
If colOutput.Item(iCol) = colFail02 Then
If CInt(ws.Range(sX).Value) >= 99 And ws.Range(sX).Value <> "0" Then
'row failure'
sTmp = ""
Exit For
End If
End If
If iCol = 1 Then
sTmp = ws.Range(sX)
Else
If colOutput.Item(iCol) = "E" Then
sTmp = sTmp & sComma & ws.Range(sX)
Else
sTmp = sTmp & sComma & ws.Range(sX)
End If
End If
Next iCol
If sTmp <> "" Then
Print #lfn, sTmp
End If
Next lRow
Close lfn
End Sub
|