有哪位VBA高手能帮忙修改一下程序吗

LMJ733

Sub JHD最大清单号()
  On Error Resume Next
  Dim CNN As New ADODB.Connection
  Dim RST As New ADODB.Recordset
  Dim pthStr$, SQL$, XXX$, s$
  pthStr = ThisWorkbook.Path & "\商品进销单.mdb"
   s = "JH" & Year(Now) & Format(Month(Now), "00") & Format(Day(Now), "00")
   CNN.Open "Provider=Microsoft.Jet.Oledb.4.0;data Source=" & Stpath
    SQL = "select top 1 进货清单号 from JHD where left(进货清单号,10)='" & s & "' order by 进货清单号 desc"
    RST.Open SQL, CNN, adOpenStatic, adLockReadOnly
    If RST.RecordCount < 1 Then
      Range("I4").Value = "JH" & Year(Now) & Format(Month(Now), "00") & Format(Day(Now), "00") & "001"
       Else
      XXX = Format(Right(RST.Fields(0), 3) + 1, "000")
      Range("I4").Value = s & XXX
      End If
  RST.Close
  CNN.Close
  Set RST = Nothing
  Set CNN = Nothing
End Sub

我想把以上程序修改成顺序号不随日期的日而变动（因原每天都从1号开始），而是要随月的变动才重新从1号开始，但显示出来的整个顺序号还是要“年月日+编号”因其他程序取数有用到，或者能否增加一个统计每天的号数的合计数，以月为合计单位，即总第X号。请高手们帮忙一下啦，在些谢谢大家啦！