1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
| Private Sub cmdAllega_Click()
'DECLARATIONS
'------------
Dim varFilter As Variant
Dim strPath As String
Dim strFile As String
Dim RC As Integer
Dim inErrNumber As Integer
Dim SQL As String
'INITIALIZE
'----------
On Error GoTo ErrHandler
'MAIN BODY
'---------
'-- Build list of file types to choose from
GoSub BuildListFileTypes
'Lookup the attachment path
GoSub GetAttachmentPath
'Open common dialog box for Save with parms built above
varFileName = ahtCommonFileOpenSave( _
ahtOFN_HIDEREADONLY, _
strPath, _
varFilter, _
1, _
"*.*", _
, _
"Seleziona un File da Allegare.", _
hWndAccessApp, _
True)
'If user cancelled, then exit now
If IsNull(varFileName) Then
Exit Sub
Else
Dim intI As Integer
Dim stFileName As String
Dim stFolderPath As String
Dim sPathRete As String
Dim stCodCont As String
Dim inLen As Integer, inI As Integer
stCodCont = "RDA" & Format(IDRDA.Value, "000000")
sPathRete = DLookup("[Value]", "tblParameters", "[Parameter]='DiscoRete'")
'LAN
stFolderPath = sPathRete & "RDA\Allegati\" & Format(stCodCont, "000000")
'Locale
'stFolderPath = PathDB() & "Allegati\Fatture\" & Format(stCodCont, "000000")
If Dir(stFolderPath, vbDirectory) = vbNullString Then
MkDir stFolderPath
End If
stFileName = varFileName
'LAN
stFolderPath = sPathRete & "RDA\Allegati\" & Format(stCodCont, "000000")
'Locale
'stFolderPath = PathDB() & "Allegati\Fatture\" & stCodCont
inLen = Len(stFileName)
inI = Len(stFileName)
Do While Mid$(stFileName, inI, 1) <> "\"
inI = inI - 1
Loop
stFileName = Right$(stFileName, inLen - inI)
FileCopy varFileName, stFolderPath & "\" & stFileName
Me!txtFileName = stFileName & "#" & stFolderPath & "\" & stFileName & "#"
End If
'WRAP-UP
'-------
WrapUp:
Exit Sub
'ERROR HANDLER
'-------------
ErrHandler:
MsgBox Err.Description
Resume WrapUp
'CODE SNIPPETS
'-----------------------------------------------------------------------------------------------
BuildListFileTypes:
'-----------------------------------------------------------------------------------------------
'-- This code sets up all of the common dialog file types to pick from.
'Word
'varFilter = ahtAddFilterItem(CStr(varFilter), "Word Documents (*.doc)", "*.doc")
'Excel
varFilter = ahtAddFilterItem(CStr(varFilter), "Scegli Documento (*.*)", "*.*")
Return
'-----------------------------------------------------------------------------------------------
GetAttachmentPath:
'-----------------------------------------------------------------------------------------------
'-- This code looks up the data path for the current project databbase. If the attachment path
' does not already exist it will create it.
strPath = "C:\"
Return
End Sub |
