创建表单以提交包含内容的csv文件

时间:2017-02-15 12:14:11

标签: excel vba export

我有以下问题:

为了能够部署多个设备,我编辑了一些我在这里和那里找到的VBA代码,此刻我已经迷失了......因为我不是编码员,而且我不是&#39确切地了解代码的作用,我无法弄清楚解决方案。

问题是:当我添加1个设备时,.csv文件会混乱数据:

HOSTNAMEHQ,COUNTRYCRE,HARDWARECRE,MAC,UUID,DESCRIPTION,PLATFORM
LPAB00000013293,,,28:F1:0E:30:81:C1,,STOCK, 
#N/A,,,#N/A,,STOCK, 
#N/A,,,#N/A,,STOCK, 
#N/A,,,#N/A,,STOCK, 
#N/A,,,#N/A,,STOCK, 
#N/A,,,#N/A,,STOCK, 
(etc)

当我添加2个或更多设备时,.csv文件就可以了:

HOSTNAMEHQ,COUNTRYCRE,HARDWARECRE,MAC,UUID,DESCRIPTION,PLATFORM
LPAB00000013293,,,28:F1:0E:30:81:C1,,STOCK, 
LPAB00000013293,,,28:F1:0E:30:81:C1,,STOCK, 

我使用的代码是:

    Sub Button_Click()
    Call SaveWorksheetsAsCsv
    End Sub

    Sub SaveWorksheetsAsCsv()
    On Error Resume Next
    Dim i As Long
    Errorknop = vbCritical + vbOKOnly
    ThisWorkbook.Sheets("Export").Visible = xlSheetVisible
    ThisWorkbook.Sheets("Export").Activate
    Range("A1").Select
    Selection.End(xlDown).Select
    LaRo = ActiveCell.Row
    Range("A1").Select




    Range("A2").Select
    Selection.End(xlDown).Select
    LR = ActiveCell.Row
    LC = Last(4, ActiveSheet.Cells)
    LCR = LC & LR
    Range("B1:" & LCR).Copy
    ThisWorkbook.Sheets("Export").Visible = xlSheetHidden
    ThisWorkbook.Sheets("Export_2").Visible = xlSheetVisible
    ThisWorkbook.Sheets("Export_2").Activate
    Range("A1").Select
    Range("A1").PasteSpecial Paste:=xlPasteValues

    Dim LValue As Date

    LValue = Now

    Dim SaveToDirectory As String

    Dim CurrentWorkbook As String
    Dim CurrentFormat As Long

    Dim strbody As String
        Dim SigString As String
        Dim Signature As String


    CurrentWorkbook = ThisWorkbook.FullName
    CurrentFormat = ThisWorkbook.FileFormat


     SaveToDirectory = "D:\Testmap\Formulieren\"
    Worksheets("Export_2").SaveAs Filename:=SaveToDirectory & Day(LValue) & Month(LValue) & Year(LValue) & Hour(LValue) & Minute(LValue) & Second(LValue) & "_1IMPORT_TEMPLATE_NN_AD_SCCM_HP", FileFormat:=xlCSV
    ThisWorkbook.Saved = True



    Application.Quit
    End Sub

    Function Last(choice As Integer, rng As Range)
    ' 1 = last row
    ' 2 = last column (R1C1)
    ' 3 = last cell
    ' 4 = last column (A1)
        Dim lrw As Long
        Dim lcol As Integer

        Select Case choice
        Case 1:
            On Error Resume Next
            Last = rng.Find(What:="*", _
                            After:=rng.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Row
            On Error GoTo 0

        Case 2:
            On Error Resume Next
            Last = rng.Find(What:="*", _
                            After:=rng.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
            On Error GoTo 0

        Case 3:
            On Error Resume Next
            lrw = rng.Find(What:="*", _
                           After:=rng.Cells(1), _
                           LookAt:=xlPart, _
                           LookIn:=xlFormulas, _
                           SearchOrder:=xlByRows, _
                           SearchDirection:=xlPrevious, _
                           MatchCase:=False).Row
            lcol = rng.Find(What:="*", _
                            After:=rng.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
            Last = Cells(lrw, lcol).Address(False, False)
            If Err.Number > 0 Then
                Last = rng.Cells(1).Address(False, False)
                Err.Clear
            End If
            On Error GoTo 0
        Case 4:
            On Error Resume Next
            Last = rng.Find(What:="*", _
                            After:=rng.Cells(1), _
                            LookAt:=xlPart, _
                            LookIn:=xlFormulas, _
                            SearchOrder:=xlByColumns, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False).Column
            On Error GoTo 0
            Last = R1C1converter("R1C" & Last, 1)
            For i = 1 To Len(Last)
                s = Mid(Last, i, 1)
                If Not s Like "#" Then s1 = s1 & s
            Next i
            Last = s1

        End Select

    End Function




    Function GetBoiler(ByVal sFile As String) As String
    'Dick Kusleika
        Dim fso As Object
        Dim ts As Object
        Set fso = CreateObject("Scripting.FileSystemObject")
        Set ts = fso.GetFile(sFile).OpenAsTextStream(1, -2)
        GetBoiler = ts.readall
        ts.Close
    End Function



    Function R1C1converter(Address As String, Optional R1C1_output As Integer, Optional RefCell As Range) As String
        'Converts input address to either A1 or R1C1 style reference relative to RefCell
        'If R1C1_output is xlR1C1, then result is R1C1 style reference.
        'If R1C1_output is xlA1 (or missing), then return A1 style reference.
        'If RefCell is missing, then the address is relative to the active cell
        'If there is an error in conversion, the function returns the input Address string
        Dim x As Variant
        If RefCell Is Nothing Then Set RefCell = ActiveCell
        If R1C1_output = xlR1C1 Then
            x = Application.ConvertFormula(Address, xlA2, xlR1C1, , RefCell) 'Convert A2 to R1C1
        Else
            x = Application.ConvertFormula(Address, xlR1C1, xlA2, , RefCell) 'Convert R1C1 to A2
        End If
        If IsError(x) Then
            R1C1converter = Address
        Else
            'If input address is A1 reference and A1 is requested output, then Application.ConvertFormula
            'surrounds the address in single quotes.
            If Right(x, 1) = "'" Then
                R1C1converter = Mid(x, 2, Len(x) - 2)
            Else
                x = Application.Substitute(x, "$", "")
                R1C1converter = x
            End If
        End If
    End Function

对于编码器而言,这可能是完全合乎逻辑的,甚至是一团糟,但我真的希望有人可以给我解决方案以便脚本运行,获取单元格的信息,然后在找到时停止空单元格。在那一刻,写下.csv文件并关闭。

1 个答案:

答案 0 :(得分:0)

我使用F8的逐步方法找到了解决方案。找到最后一行是错误的位置。现在我正在使用:

etc/crontab