Option Explicit
'** For step 4 **
'Step 4 API usage
Public LFAPI As LFAPI32COMLib.LFAPI32
'** For step 1 **
'Opens a treeview custom control to browse to a folder to convert .wma's
Private sBuffer As String
Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Const MAX_PATH = 260
Private Declare Function SHBrowseForFolder Lib "shell32" _
(lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" _
(ByVal pidList As Long, _
ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" _
(ByVal lpString1 As String, ByVal _
lpString2 As String) As Long
Private Type BrowseInfo
hWndOwner As Long
pIDLRoot As Long
pszDisplayName As Long
lpszTitle As Long
ulFlags As Long
lpfnCallback As Long
lParam As Long
iImage As Long
End Type
'End custom control
'** For step 1 **
'Deletes the last 3 lines of backuped .wma files so it can be read into VB
Private Sub deleteLine(line As Integer, fileStr As String)
Dim sLine As String
Dim sFile As String
Dim ff As Integer
ff = FreeFile
Open fileStr For Input As #ff
Dim lineNum As Integer
lineNum = 0
While Not EOF(ff)
'in case you want to delete by line number
lineNum = lineNum + 1
Line Input #ff, sLine
'just an example you could also see if strLine = the line you want to delete
If lineNum <> line Then
sFile = sFile & sLine & vbCrLf
End If
Wend
Close (ff)
ff = FreeFile
Open fileStr For Output As #ff
Print #ff, sFile
Close (ff)
End Sub
'** For step 1 **
'Opens a Treeview control that displays the folders in a computer
Private Sub cmdConvertFolder_Click()
Dim lpIDList As Long
Dim szTitle As String
Dim response As Integer
Dim tBrowseInfo As BrowseInfo
szTitle = "This is the title"
With tBrowseInfo
.hWndOwner = Me.hWnd
.lpszTitle = lstrcat(szTitle, "")
.ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
End With
'lpIDList = SHBrowseForFolder(tBrowseInfo) 'original place
If (lpIDList) Then
sBuffer = Space(MAX_PATH)
SHGetPathFromIDList lpIDList, sBuffer
sBuffer = Left(sBuffer, InStr(sBuffer, vbNullChar) - 1)
'MsgBox sBuffer
End If
response = MsgBox("Did you backup your .wma files? All .wma files in this folder will be converted!", vbExclamation + vbYesNoCancel, "ECS Importer")
If response = vbYes Then
lpIDList = SHBrowseForFolder(tBrowseInfo) 'moved to go w/ the vbYes response
OpenPath sBuffer, ".wma"
Else
'do nothing
End If
End Sub
'Part of the above sub
Private Sub OpenPath(strPath As String, Optional extension As String)
'Leave Extension blank for all files
Dim File As String
If Right$(strPath, 1) <> "\" Then strPath = strPath & "\"
If Trim$(extension) = "" Then
extension = "*.*"
ElseIf Left$(extension, 2) <> "*." Then
extension = "*." & extension
End If
File = Dir$(strPath & extension)
Do While Len(File)
deleteLine 3, File
File = Dir$
Loop
End Sub
'** Step 2 & 3 **
'Opens commond dialog box to find which file you want to extract
Private Sub cmdRead_Click()
On Error Resume Next
Dim strFileLine As String
Dim strOfficer As String
Dim strDate As String
Dim strYear As String
Dim strMonth As String
Dim strDay As String
Dim strStartTime
Dim strEndTime
Dim strStartHour As String
Dim strStartMin As String
Dim strStartSec As String
Dim strEndHour As String
Dim strEndMin As String
Dim strEndSec As String
With CommonDialog1
'raise an error if cancel was hit
.Filter = ".wma files (*.wma)|*.wma|" & "All files (*.*)|*.*"
.Flags = cdlOFNHideReadOnly
.CancelError = True
.ShowOpen
' 32755 is the cancel error raised
If Err.Number = 32755 Then
Exit Sub
Else
Open CommonDialog1.FileName For Input As #1
Line Input #1, strFileLine 'All the information in the .wma file ready to extract
Close #1
End If
End With
txtDoc.Text = CommonDialog1.FileTitle
txtOfficer.Text = Mid(strFileLine, 56, 4)
strDate = Mid(strFileLine, 79, 6)
strMonth = Mid(strDate, 3, 2)
strDay = Mid(strDate, 5, 2)
strYear = Mid(strDate, 1, 2)
txtDate.Text = strMonth & "/" & strDay & "/" & strYear
strStartHour = Mid(strFileLine, 85, 2)
strStartMin = Mid(strFileLine, 87, 2)
strStartSec = Mid(strFileLine, 89, 2)
strEndHour = Mid(strFileLine, 97, 2)
strEndMin = Mid(strFileLine, 99, 2)
strEndSec = Mid(strFileLine, 101, 2)
txtStartTime.Text = strStartHour & ":" & strStartMin & ":" & strStartSec
txtEndTime.Text = strEndHour & ":" & strEndMin & ":" & strEndSec
End Sub
'** Step 4 **
'Inserts the info into LF
Private Sub cmdInsert_Click()
Set LFAPI = New LFAPI32COMLib.LFAPI32
Dim strCreateDoc As String
Dim strImport As String
LFAPI.LoginEx "ECS Demo 6", "admin", "admin"
LFAPI.CreateFolder "WMA", "ECS Demo 6"
strImport = LFAPI.ImportElectronicFile _
(CommonDialog1.FileName, "ECS Demo 6\WMA", txtDoc.Text, , , "WMA")
LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Officer", txtOfficer.Text
LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Date", txtDate.Text
LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "Start Time", txtStartTime.Text
LFAPI.SetFieldValue "ECS Demo 6\WMA\" & txtDoc.Text, "End Time", txtEndTime.Text
LFAPI.Logout
MsgBox "Document successfully created in LaserFiche.", vbInformation, "ECS Importer"
End Sub
