[求助]关于不规则自动编码及文件管理 - 专家坐堂 - Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

1、编号参考：

Select e.DataCol.Name

Case "日期","客户"

If e.DataRow.IsNull("日期") OrElse e.DataRow.IsNull("客户") Then

e.DataRow("客户月编号") = Nothing

Else

Dim d As Date = e.DataRow("日期")

Dim y As Integer = d.Year

Dim m As Integer = d.Month

Dim Days As Integer = Date.DaysInMonth(y,m)

Dim fd As Date = New Date(y,m,1) '获得该月的第一天

Dim ld As Date = New Date(y,m,Days) '获得该月的最后一天

Dim bh As String = e.DataRow("客户") & "-" & Format(d,"yyyyMM") & "-" '生成编号的前缀

If e.DataRow("客户月编号").StartsWith(bh) = False '如果客户月编号前缀不符

Dim max As String

Dim idx As Integer

Dim flt As String

flt = "客户 = '"& e.DataRow("客户") & "' And 日期 >= #" & fd & "# And 日期 <= #" & ld & "# And [_Identify] <> " & e.DataRow("_Identify")

max = e.DataTable.Compute("Max(客户月编号)",flt) '取得该月的相同客户的最大客户月编号

If max > "" Then '如果存在最大客户月编号

idx = CInt(max.Substring(bh.Length)) + 1 '获得最大客户月编号的后四位顺序号,并加1

Else

idx = 1 '否则顺序号等于1

End If

e.DataRow("客户月编号") = bh & Format(idx,"0000")

End If

End Select

2、动态目录参考：http://www.foxtable.com/webhelp/topics/2209.htm

创建目录参考：

Dim path As String = "D:\资料管理\"

Select Case e.DataCol.Name

Case "供应商名称"

If e.NewValue > "" Then

If FileSys.DirectoryExists(path & e.NewValue) = False

FileSys.CreateDirectory(path & e.NewValue)

End If

If FileSys.DirectoryExists(path & e.DataRow("供应商名称")) = False

FileSys.CreateDirectory(path & e.DataRow("供应商名称"))

End If

Case "项目名称"

If e.NewValue > "" AndAlso e.DataRow.IsNull("供应商名称") = False Then

If FileSys.DirectoryExists(path & e.DataRow("供应商名称")) = False

FileSys.CreateDirectory(path & e.DataRow("供应商名称"))

End If

If FileSys.DirectoryExists(path & e.DataRow("供应商名称") & "\" & e.NewValue) = False

FileSys.CreateDirectory(path & e.DataRow("供应商名称") & "\" & e.NewValue)

End If

End Select

添加文件到任意目录只能通过按钮添加，无法通过扩展列窗口添加：

把列属性自动复制附件设置为false

然后按钮代码类似：

Dim r As DataRow = Tables("资料管理").Current

If r IsNot Nothing Then

Dim path As String = "D:\资料管理\"

Dim dlg As new OpenFileDialog

If dlg.ShowDialog() = DialogResult.OK

path = path & r("供应商名称")

If FileSys.DirectoryExists(path) = False

FileSys.CreateDirectory(path)

End If

path = path & r("供应商名称") & "\" & r("项目名称")

If FileSys.DirectoryExists(path ) = False

FileSys.CreateDirectory(path)

End If

path = path & r("供应商名称") & "\" & r("项目名称") & "\供应商图档\"

If FileSys.DirectoryExists(path ) = False

FileSys.CreateDirectory(path)

End If

path = path & FileSys.GetName(dlg.FileName)

FileSys.CopyFile(dlg.FileName,path)

r("供应商图档") = IIF(r.IsNull("供应商图档"),path ,r("供应商图档") & vbcrlf & path )

End If

[此贴子已经被作者于2019/7/29 16:41:30编辑过]

想多了，不需要使用按钮添加文件，到表格currentchanged事件写代码：

If e.Table.Current Is Nothing Then Return

e.Table.Cols("供应商图档").DataCol.DefaultFolder = "D:\资料管理\" & e.Table.Current("供应商名称") & "\" & e.Table.Current("项目名称") & "\供应商图档\"

e.Table.Cols("采购协议").DataCol.DefaultFolder = "D:\资料管理\" & e.Table.Current("供应商名称") & "\" & e.Table.Current("项目名称") & "\采购协议\"

e.Table.Cols("验厂记录").DataCol.DefaultFolder = "D:\资料管理\" & e.Table.Current("供应商名称") & "\" & e.Table.Current("项目名称") & "\验厂记录\"

e.Table.Cols("供应商图档").DataCol.DefaultFolder = "\\192.168.0.100\资料管理\" & e.Table.Current("供应商名称")

主题：[求助]关于不规则自动编码及文件管理