Print

Option Compare Database
Option Explicit

Function CreateThumbsToAllScores()
'---------------------------------------------------------------------------------------
' Date : 01-12-2019 Take5-V5 Ver. 8 : 148 Author : Jakob Gram
' Purpose : Check all files in tblFile and set the max size to 3600. Create Thumbs in
' 600 pix (If they are bigger) and Miniatures in 150 pix. Updates tblScore
' Modified :
'---------------------------------------------------------------------------------------
On Error GoTo CreateThumbsToAllScores_Error

Dim dbs As Database
Dim rst As Recordset
Dim rstScr As Recordset
Dim varSize As Variant
Dim lngWidth, lngHeight, lngSize As Long
Dim i, intCnt As Integer

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM tblFile ORDER BY FileID")

While Not rst.EOF
rst.Edit
varSize = CreateThumbMin(rst!FPath & rst!fname, 3600)
lngWidth = varSize(0)
lngHeight = varSize(1)
lngSize = varSize(2)
Set rstScr = dbs.OpenRecordset("SELECT * FROM tblScore WHERE scrFilename = """ & rst!fname & """")
intCnt = rstScr.RecordCount
Select Case intCnt
Case 0
rst!Mark = "Filename not found in tblScore"
AutoInfo "File not found Score: " & rst!fname
Case 1
rstScr.Edit
rstScr!scrWidth = lngWidth
rstScr!scrHeight = lngHeight
rstScr!scrSize = lngSize
rstScr!scrUpdated = Now
AutoInfo "Updating Score: " & rst!fname
rstScr.Update
rstScr.Close
rst!Mark = ""
Case Else
rst!Mark = "More than 1 Filename found in tblScore"
AutoInfo "More than 1 Score: " & rst!fname
End Select
Set rstScr = Nothing
rst!DateCreated = Now
rst.Update
i = i + 1
AutoInfo "Updating File (" & i & ") : " & rst!fname
rst.MoveNext
Wend

' Information
AutoInfo ("Kørsel er afsluttet!")
Forms.frmAuto.autLastRun = Now()

On Error GoTo 0
Exit Function
CreateThumbsToAllScores_Error:
Call LogError(Erl, Err.Number, Err.Description, "modAuto : CreateThumbsToAllScores")
Stop
Exit Function
End Function

Function CreateThumbsToAllImages()
'---------------------------------------------------------------------------------------
' Date : 24-11-2019 Take5-V5 Ver. 8 : 147 Author : Jakob Gram
' Purpose : Check all files in tblFile and set the max size to 2400. Create Thumbs in
' 600 pix (If they are bigger) and Miniatures in 150 pix. Updates tblImage
' Modified :
'---------------------------------------------------------------------------------------
On Error GoTo CreateThumbsToAllImages_Error

Dim dbs As Database
Dim rst As Recordset
Dim rstImg As Recordset
Dim varSize As Variant
Dim lngWidth, lngHeight, lngSize As Long
Dim i, intCnt As Integer

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM tblFile ORDER BY FileID")

While Not rst.EOF
rst.Edit
varSize = CreateThumbMin(rst!FPath & rst!fname, 2400)
lngWidth = varSize(0)
lngHeight = varSize(1)
lngSize = varSize(2)
Set rstImg = dbs.OpenRecordset("SELECT * FROM tblImage WHERE imgFilename = """ & rst!fname & """")
intCnt = rstImg.RecordCount
Select Case intCnt
Case 0
rst!Mark = "Filename not found in tblImage"
AutoInfo "File not found Image: " & rst!fname
Case 1
rstImg.Edit
rstImg!imgWidth = lngWidth
rstImg!imgHeight = lngHeight
rstImg!imgSize = lngSize
rstImg!imgUpdated = Now
AutoInfo "Updating Image: " & rst!fname
rstImg.Update
rstImg.Close
rst!Mark = ""
Case Else
rst!Mark = "More than 1 Filename found in tblImage"
AutoInfo "More than 1 Image: " & rst!fname
End Select
Set rstImg = Nothing
rst!DateCreated = Now
rst.Update
i = i + 1
AutoInfo "Updating File (" & i & ") : " & rst!fname
rst.MoveNext
Wend

' Information
AutoInfo ("Kørsel er afsluttet!")
Forms.frmAuto.autLastRun = Now()
'Forms.frmAuto.autSuccess = True

On Error GoTo 0
Exit Function
CreateThumbsToAllImages_Error:
Call LogError(Erl, Err.Number, Err.Description, "modAuto : CreateThumbsToAllImages")
Stop
Exit Function
End Function

Function ReadAllImageFileToTable()
'---------------------------------------------------------------------------------------
' Date : 23-11-2019 Take5-V5 Ver. 8 : 147 Author : Jakob Gram
' Purpose : Read all files from Image directory to tblFile
' Modified :
'---------------------------------------------------------------------------------------
On Error GoTo ReadAllImageFileToTable_Error

Dim strFileSpec As String
strFileSpec = "*_T5v5.jpg" ' Only ordinary files; "Main files"

ListFilesToTable DLookup("sysFpath", "tblSys") & "Image\", strFileSpec, False

On Error GoTo 0
Exit Function
ReadAllImageFileToTable_Error:
Call LogError(Erl, Err.Number, Err.Description, "modAuto : ReadAllImageFileToTable")
Stop
Exit Function
End Function

Function ReadAllScoreFileToTable()
'---------------------------------------------------------------------------------------
' Date : 01-12-2019 Take5-V5 Ver. 8 : 148 Author : Jakob Gram
' Purpose : Read all files from Score directory to tblFile
' Modified :
'---------------------------------------------------------------------------------------
On Error GoTo ReadAllScoreFileToTable_Error

Dim strFileSpec As String
strFileSpec = "*_T5v5.jpg" ' Only ordinary files; "Main files"

ListFilesToTable DLookup("sysFpath", "tblSys") & "Score\", strFileSpec, False

On Error GoTo 0
Exit Function
ReadAllScoreFileToTable_Error:
Call LogError(Erl, Err.Number, Err.Description, "modAuto : ReadAllScoreFileToTable")
Stop
Exit Function
End Function

Function CreateRelRlsTrk()
' Tabellen relRlsTrk har plads til felterne rlsID og trkID.
' Desuden har den relNum (Nummerering) og relStar (10 char) som er til ratings.
' Disse 2 felters indhold mistes. Gennemløber alle Tracks og danne tilsvarende records i tabellen.

' Dimension
Dim dbs As Database
Dim rst As Recordset
Dim rstRel As Recordset

' Values
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Set rstRel = dbs.OpenRecordset("relRlsTrk")

' Prog
While Not rst.EOF
AutoInfo ("Behandler: " & rst!trkID & " - " & rst!trkTitle)
rstRel.AddNew
rstRel!rlsID = rst!trkAlID
rstRel!trkID = rst!trkID
rstRel.Update
rst.MoveNext
Wend

' Cleanup
rst.Close
rstRel.Close
Set rst = Nothing
Set rstRel = Nothing
dbs.Close
Set dbs = Nothing

' Information
AutoInfo ("Kørsel er afsluttet!")
Forms.frmAuto.frmLastRun = Now()
Forms.frmAuto.autSuccess = True

End Function

Function UpdateArtistOnAlbum()

Dim dbs As Database
Dim rst As Recordset
Dim rstTrk As Recordset
Dim iMA As Variant

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM tblAlbum ORDER BY albID")

While Not rst.EOF
iMA = DLookup("trkArID", "tblTrack", "trkAlID = " & rst!albID)
If IsDigit(iMA) Then
rst.Edit
rst!albMainArtist = iMA
rst!albUpdated = Now()
rst.Update
End If

rst.MoveNext
Wend

Set rst = Nothing
Set dbs = Nothing

End Function

Function MarkUnusedMfiles()
' Find musikfiler der ikke kan slås op i tblTrack
Dim dbs As Database
Dim rst As Recordset
Dim rstTrk As Recordset
Dim varCnt As Variant

Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM Files ORDER BY FileID")

While Not rst.EOF
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkFilename = """ & rst!fname & """")
varCnt = rstTrk.RecordCount
If Not IsDigit(varCnt) Then
' File not Found
rst.Edit
rst!Mark = "Not Found"
rst.Update
End If
rstTrk.Close
Set rstTrk = Nothing
rst.MoveNext
Wend

rst.Close
Set rst = Nothing
dbs.Close
Set dbs = Nothing

End Function

Function MoveMainToTrack()
' Flyt de sidste poster fra main til track
Dim dbs As Database
Dim rstMin As Recordset
Dim rstTrk As Recordset
Dim intCnt As Integer

Set dbs = CurrentDb
Set rstMin = dbs.OpenRecordset("SELECT * FROM tblMain ORDER BY minID")

While Not rstMin.EOF
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkTiID = " & rstMin!minMainWork)
intCnt = rstTrk.RecordCount
If intCnt > 0 Then
' Modify records
While Not rstTrk.EOF
rstTrk.Edit
rstTrk!trkTitle = rstMin!minTitle
rstTrk!trkVersion = rstMin!minRemark
If Not IsNull(rstMin!minArtist) Then
rstTrk!trkArtist = DLookup("artName", "tblArtist", "artID = " & rstMin!minArtist)
End If
rstTrk!trkArID = DLookup("matID", "tblMainArtist", "matArtistName = '" & rstTrk!trkArtist & "'")
rstTrk!trkSubArtist = rstMin!minArtist
If Not IsNull(rstMin!minComposer) Then
rstTrk!trkComposer = DLookup("prsName", "tblPerson", "prsID = " & rstMin!minComposer)
End If
rstTrk!trkCoID = rstMin!minComposer
If Not IsNull(rstMin!minAlbum) Then
rstTrk!trkAlbum = DLookup("albTitle", "tblAlbum", "albID = " & rstMin!minAlbum)
End If
rstTrk!trkAlID = rstMin!minAlbum
rstTrk!trkArranger = rstMin!minArranger
rstTrk!trkYear = rstMin!minYear
rstTrk!trkArranger = rstMin!minArranger
rstTrk!trkTempo = rstMin!minTempo
rstTrk!trkNotes = rstMin!minNotes
rstTrk!trkFileName = rstMin!minMusicFile
rstTrk!trkScoreFile = rstMin!minScoreFile
rstTrk!trkUpdated = Now()
rstTrk.Update
rstTrk.MoveNext
Wend
rstTrk.Close
Set rstTrk = Nothing
Else
' Create record
Set rstTrk = Nothing
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")

rstTrk.AddNew
rstTrk!trkTitle = rstMin!minTitle
rstTrk!trkTiID = rstMin!minMainWork
rstTrk!trkVersion = rstMin!minRemark
If Not IsNull(rstMin!minArtist) Then
rstTrk!trkArtist = DLookup("artName", "tblArtist", "artID = " & rstMin!minArtist)
End If
rstTrk!trkArID = DLookup("matID", "tblMainArtist", "matArtistName = '" & rstTrk!trkArtist & "'")
rstTrk!trkSubArtist = rstMin!minArtist
If Not IsNull(rstMin!minComposer) Then
rstTrk!trkComposer = DLookup("prsName", "tblPerson", "prsID = " & rstMin!minComposer)
End If
rstTrk!trkCoID = rstMin!minComposer
If Not IsNull(rstMin!minAlbum) Then
rstTrk!trkAlbum = DLookup("albTitle", "tblAlbum", "albID = " & rstMin!minAlbum)
End If
rstTrk!trkAlID = rstMin!minAlbum
rstTrk!trkArranger = rstMin!minArranger
rstTrk!trkYear = rstMin!minYear
rstTrk!trkArranger = rstMin!minArranger
rstTrk!trkTempo = rstMin!minTempo
rstTrk!trkNotes = rstMin!minNotes
rstTrk!trkFileName = rstMin!minMusicFile
rstTrk!trkScoreFile = rstMin!minScoreFile

rstTrk.Update
rstTrk.Close
Set rstTrk = Nothing
End If

rstMin.MoveNext
Wend
Set dbs = Nothing

End Function
Function UpdateMainTrack(Optional ByVal recID As Integer)
' Opdaterer tblMain fra tblTrack.
' Der tilføjes bla. et billede til Main.

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath, strSQL As String
Dim varImage As Variant
Dim dbs As Database
Dim rstTrk As Recordset
Dim rstMin As Recordset
' END DIM -----------------------------------------------

' SET ---------------------------------------------------
intRec = recID
i = 0
j = 0
strIpath = DLookup("sysInstallPath", "tblSystem")
Set dbs = CurrentDb
If intRec = 0 Then
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Else
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & intRec)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
While Not rstTrk.EOF
AutoInfo "Updating from : " & rstTrk!trkID & " - " & rstTrk!trkTitle
strSQL = "SELECT * FROM tblMain WHERE minMainWork = " & rstTrk!trkTiID & " AND minArtist = " _
& rstTrk!trkArID & " AND minAlbum = " & rstTrk!trkAlID & " ORDER BY minID"
Set rstMin = dbs.OpenRecordset(strSQL)
intCnt = rstMin.RecordCount
If intCnt > 0 Then
' Edit recordS
While Not rstMin.EOF
AutoInfo "Modifying : " & rstMin!minID & " - " & rstMin!minTitle

rstMin.Edit
rstMin!minTitle = rstTrk!trkTitle
rstMin!minYear = rstTrk!trkYear
rstMin!minComposer = rstTrk!trkCoID

' Musicfile:
If Not IsString(rstMin!minMusicFile) Then
rstMin!minMusicFile = rstTrk!trkFileName
Else
If Not FileExists(strIpath & "Audio\" & rstMin!minMusicFile) Then
rstMin!minMusicFile = rstTrk!trkFileName
End If
End If
' Imagefile:
varImage = DLookup("mwkImageFile", "tblMainWork", "mwkID = " & rstMin!minMainWork)
If Not IsString(rstMin!minImageFile) Then
If IsString(varImage) Then
rstMin!minImageFile = varImage
End If
Else
If Not FileExists(strIpath & "Images\" & rstMin!minImageFile) Then
If IsString(varImage) Then
rstMin!minImageFile = varImage
End If
End If
End If

If rstMin!minLength = 0 Then rstMin!minLength = rstTrk!trkLength
rstMin!minUpdated = Now()
intRec = rstMin!minID
rstMin.Update
i = i + 1
rstMin.MoveNext
Wend
Set rstMin = Nothing

Else
' Create 1 record
Set rstMin = dbs.OpenRecordset("tblMain")
rstMin.AddNew

rstMin!minTitle = rstTrk!trkTitle
rstMin!minMainWork = rstTrk!trkTiID
rstMin!minArtist = rstTrk!trkArID
rstMin!minAlbum = rstTrk!trkAlID
rstMin!minYear = rstTrk!trkYear
rstMin!minComposer = rstTrk!trkCoID
rstMin!minMusicFile = rstTrk!trkFileName

varImage = DLookup("mwkImageFile", "tblMainWork", "mwkID = " & rstMin!minMainWork)
If IsString(varImage) Then
rstMin!minImageFile = varImage
End If

rstMin!minLength = Val(rstTrk!trkLength)

rstMin.Update
intRec = rstMin!minID
Set rstMin = Nothing

rstTrk.Edit
rstTrk!trkMainID = intRec ' !!!!!!!!!!!!!!!!!!!!!!!!
rstTrk!trkUpdated = Now()
rstTrk.Update

j = j + 1

End If

rstTrk.MoveNext
Wend

Set rstTrk = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

' END PROG ----------------------------------------------

End Function

Function UpdatePersonTrack(Optional ByVal recID As Integer)
' Opdaterer tblPerson fra tblTrack.
' Alt hvad angår Composers checkes og prsID oprettes i Track.

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath As String
Dim varName As Variant
Dim dbs As Database
Dim rstTrk As Recordset
Dim rstPrs As Recordset

' END DIM -----------------------------------------------

' SET ---------------------------------------------------
i = 0
j = 0
strIpath = DLookup("sysInstallpath", "tblSystem")
Set dbs = CurrentDb
If recID = 0 Then
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Else
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & recID)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
While Not rstTrk.EOF
varName = rstTrk!trkComposer
If IsString(varName) Then
Set rstPrs = dbs.OpenRecordset("SELECT * FROM tblPerson WHERE prsName = """ & rstTrk!trkComposer & """ ORDER BY prsID")
intCnt = rstPrs.RecordCount
intRec = 0
AutoInfo "Updating Track-ID : " & rstTrk!trkID & " - " & varName

If intCnt > 0 Then
' Modify record
intRec = rstPrs!prsID
While Not rstPrs.EOF
AutoInfo "Modifying Person-ID : " & rstPrs!prsID & " - " & rstPrs!prsName
rstPrs.Edit

If IsString(rstPrs!prsImageFile) Then
If Not FileExists(strIpath & "Images\" & rstPrs!prsImageFile) Then
rstPrs!prsImageFile = ""
End If
End If

rstPrs!prsUpdated = Now()
rstPrs.Update
rstPrs.MoveNext
Wend
Set rstPrs = Nothing
i = i + 1
Else
' Add 1 record
If IsString(rstTrk!trkComposer) Then
Set rstPrs = dbs.OpenRecordset("tblPerson")
rstPrs.AddNew
AutoInfo "Creating Person-ID : " & rstPrs!prsID & " - " & rstPrs!prsName
rstPrs!prsName = rstTrk!trkComposer
rstPrs!prsNotes = "Created from Track " & rstTrk!trkID & " - " & Now()

rstPrs.Update
intRec = rstPrs!prsID
Set rstPrs = Nothing
j = j + 1
Else
intRec = 0
End If
End If

rstTrk.Edit
rstTrk!trkCoID = intRec ' !!!!!!!!!!!!!!!!!!!!!!!!
rstTrk!trkUpdated = Now()
rstTrk.Update
End If
rstTrk.MoveNext
Wend

Set rstTrk = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

End Function
Function UpdateAlbumTrack(Optional ByVal recID As Integer)
' Opdaterer tblAlbum fra tblTrack.
' Alt hvad angår Album checkes og albID oprettes i Track.
' Et billede kopieres fra Track

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath As String
Dim varTitle As Variant
Dim dbs As Database
Dim rstTrk As Recordset
Dim rstAlb As Recordset

' END DIM -----------------------------------------------

' SET ---------------------------------------------------
intRec = recID
i = 0
j = 0
strIpath = DLookup("sysInstallpath", "tblSystem")
Set dbs = CurrentDb
If intRec = 0 Then
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Else
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & intRec)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
While Not rstTrk.EOF
If IsString(rstTrk!trkAlbum) Then
Set rstAlb = dbs.OpenRecordset("SELECT * FROM tblAlbum WHERE albTitle = """ & rstTrk!trkAlbum & """ ORDER BY albID")
intCnt = rstAlb.RecordCount
intRec = 0
AutoInfo "Updating TrackID : " & rstTrk!trkID & " - " & varTitle

If intCnt > 0 Then
' Modify records
While Not rstAlb.EOF
AutoInfo "Modifying Album-ID : " & rstAlb!albID & " - " & rstAlb!albTitle
rstAlb.Edit

If IsString(rstAlb!albImageFile) Then
If Not FileExists(strIpath & "Cover\" & rstAlb!albImageFile) Then
rstAlb!albImageFile = ""
End If
End If

If Not IsString(rstAlb!albImageFile) Then
If IsString(rstTrk!trkImageFile) Then
rstAlb!albImageFile = rstTrk!trkImageFile
End If
End If

If Not IsString(rstAlb!albYear) Then
If IsString(rstTrk!trkYear) Then
rstAlb!albYear = rstTrk!trkYear
End If
End If

If Not IsString(rstAlb!albArtist) Then
If IsString(rstTrk!trkArtist) Then
rstAlb!albArtist = rstTrk!trkArtist
End If
End If

rstAlb!albUpdated = Now()

rstAlb.Update
i = i + 1
rstAlb.MoveNext
Wend
Set rstAlb = Nothing

Else
' Add 1 record
If IsString(rstTrk!trkAlbum) Then
Set rstAlb = dbs.OpenRecordset("tblAlbum")
rstAlb.AddNew
AutoInfo "Creating Album-ID : " & rstAlb!albID & " - " & rstAlb!albTitle
rstAlb!albTitle = rstTrk!trkAlbum

If IsString(rstTrk!trkImageFile) Then
rstAlb!albImageFile = rstTrk!trkImageFile
End If

If IsString(rstTrk!trkArtist) Then
rstAlb!albArtist = rstTrk!trkArtist
End If

If IsString(rstTrk!trkYear) Then
rstAlb!albYear = rstTrk!trkYear
End If

rstAlb!albNotes = "Created from Track " & rstTrk!trkID & " - " & Now()

rstTrk.Edit
rstTrk!trkAlID = rstAlb!albID
rstTrk!trkUpdated = Now()
rstTrk.Update

rstAlb.Update
Set rstAlb = Nothing
j = j + 1
End If
End If

End If
rstTrk.MoveNext
Wend

Set rstTrk = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

End Function

Function UpdateAfromMainArtist(Optional ByVal recID As Integer)
' Opdaterer tblArtist (Artister) fra tblMainArtist.
' Opretter poster hvor de ikke eksisterer. Der SKAL være en post i Artist for hver HovedArtist
' Så antallet af poster skal være mindst antallet i MainArtist

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath, strImg As String
Dim dbs As Database
Dim rstMat As Recordset
Dim rstArt As Recordset

' END DIM -----------------------------------------------

' SET ---------------------------------------------------
intRec = recID
i = 0
j = 0
strIpath = DLookup("sysInstallpath", "tblSystem")
Set dbs = CurrentDb
If intRec = 0 Then
Set rstMat = dbs.OpenRecordset("SELECT * FROM tblMainArtist ORDER BY matID")
Else
Set rstMat = dbs.OpenRecordset("SELECT * FROM tblMainArtist WHERE matID = " & intRec)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
While Not rstMat.EOF

intRec = 0
AutoInfo ("Updating MainArtist-ID : " & rstMat!matID) & " - " & rstMat!matArtistName
Set rstArt = dbs.OpenRecordset("SELECT * FROM tblArtist WHERE artMainArtist = " & rstMat!matID & " ORDER BY artID")
intCnt = rstArt.RecordCount

If intCnt > 0 Then
' Modify record

While Not rstArt.EOF
rstArt.Edit
AutoInfo ("Modifying Artist-ID : " & rstArt!artID)

If IsString(rstArt!artImageFile) Then
If Not FileExists(strIpath & "Images\" & rstArt!artImageFile) Then
rstArt!artImageFile = ""
rstArt!artUpdated = Now()
End If
End If

If Not IsString(rstArt!artImageFile) Then
If IsString(rstMat!matImageFile) Then
rstArt!artImageFile = rstMat!matImageFile
rstArt!artUpdated = Now()
End If
End If

If IsNull(rstArt!artImageFile) Then
rstArt!artImageFile = ""
End If
strImg = rstArt!artImageFile

rstArt.Update

rstMat.Edit
If Not IsString(rstMat!matImageFile) Then
If IsString(strImg) Then
rstMat!matImageFile = strImg
rstMat!matUpdated = Now()
End If
End If
rstMat.Update
i = i + 1
rstArt.MoveNext
Wend
Set rstArt = Nothing

Else
' Add 1 record
Set rstArt = dbs.OpenRecordset("tblArtist")
rstArt.AddNew
AutoInfo ("Creating Artist-ID : " & rstArt!artID)

rstArt!artMainArtist = rstMat!matID
rstArt!artName = rstMat!matArtistName
If IsString(rstMat!matImageFile) Then
rstArt!artImageFile = rstMat!matImageFile
End If
rstArt!artNotes = "Created from MainArtist " & rstMat!matID & " - " & Now()

rstArt.Update
Set rstArt = Nothing
j = j + 1
End If

rstMat.MoveNext
Wend

Set rstMat = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

End Function

Function UpdateMAfromTrack(Optional ByVal recID As Integer)
' Opdaterer tblMainArtist (Hovedartister) fra tblTrack.
' Alt hvad angår Artist checkes og matID oprettes i Track.
' Samt trkID i MA !

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath As String
Dim dbs As Database
Dim rstTrk As Recordset
Dim rstMat As Recordset

' END DIM -----------------------------------------------

' SET ---------------------------------------------------
intRec = recID ' Befri RecID
i = 0
j = 0
strIpath = DLookup("sysInstallpath", "tblSystem")
Set dbs = CurrentDb
If intRec = 0 Then
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Else
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & intRec)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
intRec = 0
While Not rstTrk.EOF
AutoInfo ("Updating Track-ID : " & rstTrk!trkID) & " - " & rstTrk!trkArtist

Set rstMat = dbs.OpenRecordset("SELECT * FROM tblMainArtist WHERE matArtistName = """ & rstTrk!trkArtist & """ ORDER BY matID")
intCnt = rstMat.RecordCount

If intCnt > 0 Then
' Modify record
rstMat.Edit

While Not rstMat.EOF
AutoInfo ("Modifying MainArtist-ID : " & rstMat!matID) & " - " & rstMat!matArtistName
If IsString(rstMat!matImageFile) Then
If Not FileExists(strIpath & "Images\" & rstMat!matImageFile) Then
rstMat!matImageFile = ""
End If
Else
rstMat!matImageFile = ""
End If
rstMat!matTrackID = rstTrk!trkID
rstMat!matUpdated = Now()
rstMat.Update

rstTrk.Edit
rstTrk!trkArID = rstMat!matID
rstTrk!trkUpdated = Now()
rstTrk.Update

rstMat.MoveNext
Wend

Set rstMat = Nothing
i = i + 1
Else
' Add 1 record
If IsString(rstTrk!trkArtist) Then
Set rstMat = dbs.OpenRecordset("tblMainArtist")
intRec = 0
rstMat.AddNew
AutoInfo ("Creating MainArtistID : " & rstMat!matID) & " - " & rstMat!matArtistName

rstMat!matArtistName = rstTrk!trkArtist
rstMat!matTrackID = rstTrk!trkID
intRec = rstMat!matID
rstMat!matUpdated = Now()

rstMat.Update

rstTrk.Edit
rstTrk!trkArID = intRec
rstTrk!trkUpdated = Now()
rstTrk.Update

Set rstMat = Nothing
j = j + 1
End If
End If

rstTrk.MoveNext
Wend

Set rstTrk = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

End Function
Function UpdateMWfromTrack(Optional ByVal recID As Integer)
' Opdaterer tblMainWork (Hovedværker) fra tblTrack.
' Alt hvad angår Title checkes og mwkID oprettes i Track.

' DIM ---------------------------------------------------
Dim i, j, intRec, intCnt As Integer
Dim strIpath, strTitle As String
Dim dbs As Database
Dim rstTrk As Recordset
Dim rstMwk As Recordset

' END DIM -----------------------------------------------

' SET ---------------------------------------------------
i = 0
j = 0
intRec = 0
strIpath = DLookup("sysInstallpath", "tblSystem")
Set dbs = CurrentDb
If recID = 0 Then
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack ORDER BY trkID")
Else
Set rstTrk = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & recID)
End If
' END SET -----------------------------------------------

' PROG --------------------------------------------------
While Not rstTrk.EOF
AutoInfo ("Updating TrackID : " & rstTrk!trkID)
strTitle = rstTrk!trkTitle
Set rstMwk = dbs.OpenRecordset("SELECT * FROM tblMainWork WHERE mwkTitle = """ & strTitle & """ ORDER BY mwkID")
intCnt = rstMwk.RecordCount
intRec = 0

If intCnt > 0 Then
' Modify record
rstMwk.Edit

While Not rstMwk.EOF
AutoInfo ("Modifying MainWorkID : " & rstMwk!mwkID)
If IsString(rstMwk!mwkImageFile) Then
If Not FileExists(strIpath & "Images\" & rstMwk!mwkImageFile) Then
rstMwk!mwkImageFile = ""
End If
Else
rstMwk!mwkImageFile = ""
End If

intRec = rstMwk!mwkID

rstMwk!mwkTrackID = rstTrk!trkID
rstMwk!mwkUpdated = Now()
rstMwk.Update
rstMwk.MoveNext
Wend

Set rstMwk = Nothing
i = i + 1
Else
' Add 1 record
Set rstMwk = dbs.OpenRecordset("tblMainWork")

rstMwk.AddNew

AutoInfo ("Creating MainWorkID : " & rstMwk!mwkID)
rstMwk!mwkTitle = strTitle
rstMwk!mwkNotes = "Created from Track " & rstTrk!trkID & " - " & Now()
rstMwk!mwkImageFile = ""
rstMwk!mwkTrackID = rstTrk!trkID
intRec = rstMwk!mwkID
rstMwk.Update

Set rstMwk = Nothing
j = j + 1
End If

rstTrk.Edit
rstTrk!trkTiID = intRec
rstTrk!trkUpdated = Now()
rstTrk.Update
rstTrk.MoveNext
Wend

Set rstTrk = Nothing
Set dbs = Nothing

AutoInfo ("Take5-V4 Har opdateret " & i & " og oprettet " & j & " poster.")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

End Function

Function AutoInfo(ByVal Info As String)
' Tilbagemelding til frmAuto

If IsLoaded("frmAuto") Then
Forms!frmAuto!Info = Info
Forms.frmAuto.Repaint
End If

End Function

Function InfoMp3Tag(ByVal PathFileName As String) As Boolean
' Inlæser PathFileName (Full) (fra mp3tag og tæller antal poster mm. Checker om filen er OK

' DIM ---------------------------------------------------
Dim intRec As Integer
Dim strIpath, strFileName, strFcreated, strFversion, strLine, strHead, strTemp As String
' END DIM -----------------------------------------------

' SET ---------------------------------------------------
strIpath = DLookup("sysInstallpath", "tblSystem")
strFileName = PathFileName
' END SET -----------------------------------------------

InfoMp3Tag = False
Open strFileName For Input As #1
intRec = 0
strHead = "IKKE OK"
While Not EOF(1)
Line Input #1, strLine

If Mid(strLine, 1, 20) = "Title;Artist;Album;T" Then
intRec = intRec - 1
strHead = "OK"
End If

If Left(strLine, 9) = "build on " Then
strFcreated = Mid(strLine, 10, 10)
strFversion = Mid(strLine, 34, 5)
intRec = intRec - 1
End If

intRec = intRec + 1
Wend

Close #1

strTemp = "Filens header er " & strHead & vbCrLf & vbCrLf & _
"Filen """ & strFileName & """ indeholder " & intRec & " records." _
& vbCrLf & vbCrLf & "Filen er dannet " & strFcreated & " fra programmet " _
& vbCrLf & "Mp3tag - version " & strFversion & vbCrLf & vbCrLf & "Skal filen indlæses?"

If MsgBox(strTemp, vbYesNo + vbQuestion, "Take5-V4") = vbYes Then
InfoMp3Tag = True
Else
MsgBox "Kørslen er afbrudt!", vbCritical, "Take5-V4"
End If

End Function

Function ReadNewCover(ByVal recID As Integer) As Boolean
On Error GoTo Err_ReadNewCover
' Læs en ny Coverfil ind fra \Audio\NewFiles og opdater record

' Erklæring af variabler

Dim intRec As Integer
Dim strIpath As String ' Installationssti
Dim strPath As String '
Dim strOldFile, strNewFile As String
Dim varSelectItem As Variant ' Skal være en variant, da den skal indgå i For To..Next løkke
Dim objFD As Object
Dim dbs As Database
Dim rst As Recordset

' Tildeling af værdier til variabler

ReadNewCover = False
intRec = recID

strIpath = DLookup("sysInstallPath", "tblSystem")
Set objFD = Application.FileDialog(3) ' Filedialog Open?
Set dbs = CurrentDb
Set rst = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & intRec)

objFD.InitialFileName = strIpath & "Audio\NewFiles\"
objFD.title = "Vælg Coverfilen til " & rst!trkTitle & " med " & rst!trkArtist

strOldFile = "_Cover_" & rst!trkTitle & "_" & rst!trkArtist & "_" & rst!trkAlbum & "_MB_.jpg"

AutoInfo ("Oldfile : " & strOldFile)

If Not FileExists(strIpath & "Audio\NewFiles\" & strOldFile) Then
' Mulighed for at udpege filen
With objFD
If .Show = -1 Then
For Each varSelectItem In .SelectedItems
strPath = Left(varSelectItem, InStrRev(varSelectItem, "\")) ' Ekstrakt path
strOldFile = Right(varSelectItem, Len(varSelectItem) - Len(strPath)) ' Ekstrakt filnavn
Next varSelectItem
Else
MsgBox "Forsøgest på at finde Coverfilen er opgivet!"
strOldFile = ""
End If
End With
End If
Set objFD = Nothing

strNewFile = Left(rst!trkTitle, 30) & "_" & Left(rst!trkArtist, 30) & "_" & Left(rst!trkAlbum, 30) & "_TC_" & Format(rst!trkID, "00000") & "_T5.jpg"
'strNewFile = Clean_Special(strNewFile, True)

' Omdøb fil
If FileExists(strIpath & "Audio\NewFiles\" & strOldFile) Then
If Not FileExists(strIpath & "Cover\" & strNewFile) Then
Name strIpath & "Audio\NewFiles\" & strOldFile As strIpath & "Cover\" & strNewFile
Else
If Not IsNull(rst!trkImageFile) Then
strNewFile = rst!trkImageFile
Else
strNewFile = ""
End If
End If
Else
If Not IsNull(rst!trkImageFile) Then
strNewFile = rst!trkImageFile
Else
strNewFile = ""
End If
End If

AutoInfo ("NewFile : " & strNewFile)

' Opdater record
rst.Edit
rst!trkImageFile = strNewFile
rst!trkUpdated = Now()
rst.Update

Set rst = Nothing
Set dbs = Nothing

ReadNewCover = True

Exit_ReadNewCover:
Exit Function

Err_ReadNewCover:
Close #1
MsgBox Err.Description
Resume Exit_ReadNewCover

End Function

Function ReadCmpToTrack()
On Error GoTo Err_ReadCmpToTrack
' Indlæser komponister til tblTrack

Dim i
AutoInfo "Indlæser komponister til tblTrack - ReadCmpToTrack"

' Hent den eksterne fil
' Læs en ny csv-fil ind fra \System og optæl antal poster

' Erklæring af variabler

Dim strIpath As String ' Installationssti
Dim strPath, strFileName As String '
Dim varSelectItem ' Skal være en variant, da den skal indgå i For To..Next løkke
Dim objFD As Object
Dim strLine As String
Dim strTi, strAr, strAl, strTr, strYe, strLe, strSi, strMo, strPa, strFi, strCo As String
Dim varRec As Variant
Dim strExt As String
Dim strSQL As String
Dim iMod, j, kAdd As Integer
Dim iRec, iChk As Integer
Dim dbs As Database
Dim rstMod As Recordset
Dim intFoundTag As Integer

' Tildeling af værdier til variabler

Set dbs = CurrentDb
Set rstMod = dbs.OpenRecordset("tblTrack")

strIpath = DLookup("sysInstallPath", "tblSystem")
Set objFD = Application.FileDialog(3) ' Filedialog Open?
objFD.InitialFileName = strIpath & "System\"

' Programkode

With objFD
If .Show = -1 Then
For Each varSelectItem In .SelectedItems
strPath = Left(varSelectItem, InStrRev(varSelectItem, "\")) ' Ekstrakt path
strFileName = Right(varSelectItem, Len(varSelectItem) - Len(strPath)) ' Ekstrakt filnavn
Next varSelectItem
Else
' Der er trykket på Esc
End If
End With

Set objFD = Nothing

' Tæl antal poster

Dim cntI As Integer
Dim strHead, strFcreated, strFversion, strTemp As String

Open strPath & strFileName For Input As #1
cntI = 0
strHead = "IKKE OK"
While Not EOF(1)
Line Input #1, strLine
cntI = cntI + 1

If Mid(strLine, 3, 20) = "Title;Artist;Album;T" Then
cntI = cntI - 1
strHead = "OK"
End If

If Left(strLine, 9) = "build on " Then
strFcreated = Mid(strLine, 10, 10)
strFversion = Mid(strLine, 34, 5)
cntI = cntI - 1
End If
Wend

Close #1

strTemp = "Filens header er " & strHead & vbCrLf & vbCrLf & _
"Filen """ & strFileName & """ indeholder " & cntI & " poster." _
& vbCrLf & vbCrLf & "Filen er dannet " & strFcreated & " fra programmet " _
& vbCrLf & "Mp3tag - version " & strFversion & vbCrLf & vbCrLf & "Skal filen indlæses?"

If MsgBox(strTemp, vbYesNo + vbQuestion, "Take5-V4") = vbYes Then

' Dan records fra filens oplysninger:
iMod = 0
kAdd = 0
Open strPath & strFileName For Input As #2

While Not EOF(2)
varRec = 0
iRec = 0
Line Input #2, strLine

If Mid(strLine, 3, 20) <> "Title;Artist;Album;T" Then
If Left(strLine, 9) <> "build on " Then
' Indlæsning til variabler:

j = InStr(1, strLine, ";")
strTi = Left(Mid(strLine, 1, j - 1), 50)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strAr = Left(Mid(strLine, 1, j - 1), 50)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strAl = Left(Mid(strLine, 1, j - 1), 50)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strTr = Left(Mid(strLine, 1, j - 1), 8)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strYe = Left(Mid(strLine, 1, j - 1), 8)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strLe = Left(Mid(strLine, 1, j - 1), 8)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strSi = Left(Mid(strLine, 1, j - 1), 8)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strMo = Left(Mid(strLine, 1, j - 1), 16)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strPa = Left(Mid(strLine, 1, j - 1), 128)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strFi = Left(Mid(strLine, 1, j - 1), 128)

AutoInfo ("Reading : " & strFi)

strLine = Mid(strLine, j + 1)
j = InStr(1, strLine, ";")
strCo = Left(Mid(strLine, 1, j - 1), 50)

' Find recordnummer
intFoundTag = InStr(1, strFi, "_T_")
If intFoundTag > 0 Then
' Filen er markeret korrekt
iRec = Val(Mid(strFi, intFoundTag + 3, 5))
If iRec > 0 Then
' Ret Record fordi den findes (eller fandtes) i forvejen
' Check derfor om den stadig er der
varRec = DLookup("trkId", "tblTrack", "trkID = " & iRec)

If Not IsNull(varRec) Then

Set rstMod = dbs.OpenRecordset("SELECT * FROM tblTrack WHERE trkID = " & iRec)
rstMod.Edit

AutoInfo ("Modifying : " & strFi)

If IsString(rstMod!trkTrack) = False Then
rstMod!trkTrack = strTr
End If

If IsString(rstMod!trkYear) = False Then
rstMod!trkYear = strYe
End If

If IsString(rstMod!trkLength) = False Then
rstMod!trkLength = strLe
End If

If IsString(rstMod!trkSize) = False Then
rstMod!trkSize = strSi
End If

If Not IsString(rstMod!trkComposer) Then
rstMod!trkComposer = strCo
End If

rstMod!trkModified = strMo
rstMod!trkPath = strPa

rstMod.Update
End If

Set rstMod = Nothing
iMod = iMod + 1

Else ' iRrec >0
' Recordnummer ikke fundet i filnavnet
End If
End If ' Tag ikke fundet i filnavn
End If ' If footer
End If ' If header
Wend ' EOF på fil

Close #2
Set dbs = Nothing

AutoInfo ("Kørslen har rettet " & iMod & " records i tblTrack!")
Forms!frmAuto!autLastRun = Now()
Forms!frmAuto!autSucces = True

Else
MsgBox "Kørslen er afbrudt!", vbCritical, "Take5-V4"
End If

Exit_ReadCmpToTrack:
Exit Function

Err_ReadCmpToTrack:
Close #1
Close #2
MsgBox Err.Description
Resume Exit_ReadCmpToTrack

End Function