VBA＃1：使用下一个顺序发票号保存文件（如有必要，创建文件夹）

Question

好的，这就是事情，我创建了一个下一个发票编号程序，通过按下宏指定按钮激活发票自动保存并关闭，下一个发票号码增加了。我的问题是，我希望在相关文件夹中创建excel发票发票号码的前两位数字。例如：04-001，其中04代表四月。另外，当发票编号为05-002时，应该自动创建2018-19的目录文件夹，并且发票应该只在文件夹中。我试图从一段时间后弄清楚代码，但直到现在还没有运气。到目前为止，发票是根据日期创建的，但达伦说，当我试图在12月1日的第一天创建发票时，这对我来说是个问题。

这是我目前的代码：

Sub SaveInvoiceM()
    Dim NewFN As Variant
    If Len(Dir("C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1), vbDirectory)) = 0 Then
   MkDir "C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1)
End If
    ' Copy Invoice to a New Workbook
    NewFN = "C:\Invoices\" & Format(Date, "MMM YYYY") & "-" & (Format(Date, "YY") + 1) & "\Inv" & Range("F5") & ".xlsx"
    ActiveWorkbook.saveas NewFN, FileFormat:=xlOpenXMLWorkbook
    NextInvoice
End Sub

范围（＆＃34; F5＆＃34;）代表我的发票号码，即04-001

Answer 1

我看到你要做的事情（保持良好的组织，自动），这是一个很好的目标。

我建议使用备用发票编号系统（根据我对您的情况和经验水平的理解），这将使任务（如“自动归档”过程）变得更加容易，并且还将简化您（或特别是其他人）需要回顾这些发票时的过程。有许多明显的好处（与 metric vs imperial 相同）。

理想的编号系统： （在我看来）

为减少混淆：为每个发票提供同名，而不是使用带月份的文件名
由于您需要从几个月到几年（但不是几天）的粒度：让发票/文件名包含所有这些字段。
进行排序＆amp;找到这些逻辑（更简单）：按照从大到小的顺序放置每个“日期部分”。一个独特的序号就在最后。

你的代码示例是一个良好的开端 - 当涉及到这种事情时，我只是有一点强迫症，而编号系统的创建是一项重要的任务。（此外，这将是“防止日期”，并在此过程中进行错误检查......

这与你所拥有的有点不同，因为而不是你告诉代码下一个发票编号是什么，它告诉你（通过根据现有文件按顺序计算下一个数字））。

与您的一样，如果需要，它会创建一个文件夹。由于文件的编号为YYMM-nnn，因此当您对它们进行排序时，文件的顺序始终正确。（“月份文件夹”是不必要的，因为月份在文件名中，但我仍然包括它们，因为这是你的计划。你可以将每个月的发票保存在一个文件夹中，并且它们仍然按照月份的顺序组织。）

VBA＃1：使用下一个顺序发票号保存文件（如有必要，创建文件夹）

Sub createInvoiceNumberAndSave()
    'creates a new invoice number based on date in specified cell & creates new folder if necessary
    'finds next unused invoice number & verifies that file is properly saved

    Const invoicePath = "c:\invoices\"  ' invoice root save path
    Const fNamePrefix = "Inv"           ' prefix for the filename
    Const fNameExt = ".xlsm"            ' file extension
    Const getInvoiceDate = "F5"         ' we GET the DATE of the invoice from F5
    Const putInvoiceNumber = "F6"       ' we will PUT the new filename into cell F6

    Dim invDate As Date, folderName As String, fName As String, fNum As Long, nextInvoiceNum As Long

    'get the invoice date and make sure it's valid
    If IsDate(Range(getInvoiceDate).Value) Then
        'valid date found in cell F5
        invDate = Range(getInvoiceDate).Value
    Else
        'valid date not found in F5. Do we want to default to today's date?
        If MsgBox("Cell " & getInvoiceDate & " does not contain a valid date." & vbLf & vbLf & _
            "Do you want to use today's date instead?", vbQuestion + vbOKCancel, "Date not found") <> vbOK Then
                Call MsgBox("Invoice Not Saved.", vbCritical + vbononly, "User Cancelled")
                Exit Sub 'stop running
        Else
            invDate = Date 'use today's date
        End If
    End If

    'find the next unused invoice number for this month
    folderName = Format(invDate, "YYMM")
    nextInvoiceNum = 0

    'figure out the next unused "file number"
    fName = Dir(invoicePath & folderName & "\" & fNamePrefix & folderName & "-*" & fNameExt)
    If fName = "" Then
        'file not found
        If Dir(invoicePath & folderName, vbDirectory) = "" Then
            'month not found - create folder?
            If MsgBox("Okay to create folder '" & invoicePath & folderName & "' for invoice #" & folderName & "-001 ?", _
                vbOKCancel + vbQuestion, "Folder not Found") <> vbOK Then Exit Sub
            'create folder
            MkDir (invoicePath & folderName)
        End If
    Else
        'month found. Now find the highest invoice number in the folder.
        Do While fName <> ""
            Debug.Print "Found File: " & fName
            'get the number (filename = fNamePrefix & "YYMM-___.xlsx" so we know where it is
            If IsNumeric(Mid(fName, 6 + Len(fNamePrefix), 3)) Then 'it's a valid number
                fNum = Val(Mid(fName, 6 + Len(fNamePrefix), 3))
                'if it's the biggest so far, remember it
                If fNum > nextInvoiceNum Then nextInvoiceNum = fNum 'biggest one so far
            End If
            fName = Dir
        Loop
    End If

    'we have the next available invoice#
    nextInvoiceNum = nextInvoiceNum + 1 'new invoice# (numeric)
    'PUT the new invoice# (text) in cell F6
    Range(putInvoiceNumber).Value = fNamePrefix & folderName & "-" & Format(nextInvoiceNum, "000")
    fName = invoicePath & folderName & "\" & Range(putInvoiceNumber).Value & fNameExt
    Debug.Print "Saving as: " & fName

    'save file
    ActiveWorkbook.SaveAs fName

    'DOUBLE CHECK check that file exists (couple lines of code now save a headache later)
    If Dir(fName) = "" Then
        'something went wrong (file wasn't saved)
        Call MsgBox("ERROR! FILE NOT SAVED: " & fName, vbCritical + vbOKOnly, "ERROR!")
        Stop
    End If

    'success message!
    Call MsgBox("Invoice saved successfully:" & vbLf & vbLf & fName, vbInformation, "Invoice Created")

    'NextInvoice '?

End Sub

编辑：（“回到你的路上”）

我可以想到你的方法将会成为一个问题的一些方法，其中一些我试过解释，但你决定编号＆amp;按照你的方式组织这些文件，所以“你走了”。

VBA＃2：以单元格值名称保存文件：

此过程保存当前文件，该文件以您在单元格04-001中输入的发票编号（如F5）命名（如有必要，创建文件夹）：

Sub SaveFileBasedOnInvoiceNumber() Dim monthNum As Long, yearString As String, folderName As String, fName As String 'build filename On Error Resume Next 'skip errors for now monthNum = Val(Left(Range("F5"), 2)) yearString = Year(Date) & "-" & Right(Year(Date) + 1, 2) folderName = "c:\invoices\" & StrConv(monthName(monthNum, True), vbUpperCase) & " " & yearString fName = folderName & "\INV" & Range("F5") & ".xlsm" 'check if there was a problem If Err Then MsgBox "Invalid invoice number": Exit Sub MkDir (folderName) 'create folder On Error GoTo 0 'turn error checking back on 'Confirm file saved properly ActiveWorkbook.SaveAs fName 'save file If Dir(fName) = "" Then MsgBox "Error! File not saved: " & fName: Exit Sub MsgBox "Invoice saved successfully:" & vbLf & fName End Sub

我会在答案的顶部留下“ VBA＃1 ”，以寻求其他人寻求逻辑编号＆amp;具有自动生成发票号的存储系统。

^{（有一天你会弄清楚为什么这种方式会更好，但要预先警告，以后更改你的组织方法会更麻烦！）}
祝你好运！

Excel vba下一个发票编号，按月创建自动目录文件夹

1 个答案:

VBA＃1：使用下一个顺序发票号保存文件（如有必要，创建文件夹）

VBA＃2：以单元格值名称保存文件：