by mhendu » Sat Mar 02, 2019 10:00 pm
OK, got everything working, in case anyone finds this helpful. This does not read directly from the Google Sheet and instead just downloads it as an Excel file (you'll need to share the Sheet for this to work correctly).
I can provide direction to implementing the Tasker setup on Android to populate the Google Sheet if anyone would like this.
Code: Select all
Sub Excelimport
strFileURL = "https://docs.google.com/spreadsheets/d/INSERTGOOGLEDOCID/export?format=xlsx"
strHDLocation = "c:\users\username\downloads\SongData.xlsx"
' Fetch the file
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
'Response 200 is OK, now download sheet
If objXMLHTTP.Status = 200 And objXMLHTTP.readyState = 4 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation, 2
objADOStream.Close
Set objADOStream = Nothing
End If
Dim arrSheet, intCount, firstcell, file, fso, SongIterator, Song
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt") Then
Set file = fso.OpenTextFile("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt", 1,,-1)
firstcell = file.ReadLine
If Not IsNumeric(Right(firstcell, Len(firstcell)-1)) Then firstcell = "A2"
Else
firstcell = "A2"
End If
arrSheet = ReadExcel( strHDLocation, "Sheet1", firstcell, "F1048576", False)
If IsArrayDimmed(arrsheet) Then
Dim h
For intCount = 0 To UBound(arrSheet,2)
If (arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60) < 10 Then
h = "0"&(arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60)
Else
h = (arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60)
End If
arrSheet(3,intCount) = Int(arrSheet(3,intCount)/60) & ":" & h
Set SongIterator = SDB.Database.QuerySongs(" SongTitle = '" & Replace(arrSheet(0,intCount),"'","''") & "' AND Album = '" & Replace(arrSheet(2,intCount),"'","''") & "' AND Artist = '" & Replace(arrSheet(1,intCount),"'","''") & "' ")
While Not SongIterator.EOF
Set Song = SongIterator.Item
If Song.SongLengthString = arrSheet(3,intCount) Then
Song.Rating = arrSheet(4,intCount) * 10
If Len(Song.Grouping)=0 And arrSheet(5,intCount) = "on" Then
Song.Grouping = "Instrumental"
ElseIf arrSheet(5,intCount) = "on" And InStr(Song.Grouping,"Instrumental") = 0 Then Song.Grouping = Song.Grouping & "; Instrumental"
End If
End If
Song.UpdateDB
Song.WriteTags
'SongIterator.Item.UpdateAll
SongIterator.Next
Wend
SDB.ProcessMessages
Next
Dim f,g
g = Right(firstcell, Len(firstcell)-1)
Set f = fso.CreateTextFile("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt", True, True)
f.WriteLine("A"&UBound(arrSheet,2)+1+g)
f.Close
End If
End Sub
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function : ReadExcel
' Version : 3.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile [string] The path and file name of the Excel file
' mySheet [string] The name of the worksheet used (e.g. "Sheet1")
' my1stCell [string] The index of the first cell to be read (e.g. "A1")
' myLastCell [string] The index of the last cell to be read (e.g. "D100")
' blnHeader [boolean] True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrData( ), i, j
Dim objExcel, objRS
Dim strHeader, strRange
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
' Define header parameter string for Excel object
If blnHeader Then
strHeader = "HDR=YES;"
Else
strHeader = "HDR=NO;"
End If
' Open the object for the Excel file
Set objExcel = CreateObject( "ADODB.Connection" )
' IMEX=1 includes cell content of any format; tip by Thomas Willig.
' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" & _
strHeader & """"
' Open a recordset object for the sheet and range
Set objRS = CreateObject( "ADODB.Recordset" )
strRange = mySheet & "$" & my1stCell & ":" & myLastCell
objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic
' Read the data from the Excel sheet
i = 0
Do Until objRS.EOF
' Stop reading when an empty row is encountered in the Excel sheet
If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
' Add a new row to the output array
ReDim Preserve arrData( objRS.Fields.Count - 1, i )
' Copy the Excel sheet's row values to the array "row"
' IsNull test credits: Adriaan Westra
For j = 0 To objRS.Fields.Count - 1
If IsNull( objRS.Fields(j).Value ) Then
arrData( j, i ) = ""
Else
arrData( j, i ) = Trim( objRS.Fields(j).Value )
End If
Next
' Move to the next row
objRS.MoveNext
' Increment the array "row" number
i = i + 1
Loop
' Close the file and release the objects
objRS.Close
objExcel.Close
Set objRS = Nothing
Set objExcel = Nothing
' Return the results
ReadExcel = arrData
End Function
OK, got everything working, in case anyone finds this helpful. This does not read directly from the Google Sheet and instead just downloads it as an Excel file (you'll need to share the Sheet for this to work correctly).
I can provide direction to implementing the Tasker setup on Android to populate the Google Sheet if anyone would like this.
[code]Sub Excelimport
strFileURL = "https://docs.google.com/spreadsheets/d/INSERTGOOGLEDOCID/export?format=xlsx"
strHDLocation = "c:\users\username\downloads\SongData.xlsx"
' Fetch the file
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP.3.0")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()
'Response 200 is OK, now download sheet
If objXMLHTTP.Status = 200 And objXMLHTTP.readyState = 4 Then
Set objADOStream = CreateObject("ADODB.Stream")
objADOStream.Open
objADOStream.Type = 1 'adTypeBinary
objADOStream.Write objXMLHTTP.ResponseBody
objADOStream.Position = 0 'Set the stream position to the start
objADOStream.SaveToFile strHDLocation, 2
objADOStream.Close
Set objADOStream = Nothing
End If
Dim arrSheet, intCount, firstcell, file, fso, SongIterator, Song
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt") Then
Set file = fso.OpenTextFile("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt", 1,,-1)
firstcell = file.ReadLine
If Not IsNumeric(Right(firstcell, Len(firstcell)-1)) Then firstcell = "A2"
Else
firstcell = "A2"
End If
arrSheet = ReadExcel( strHDLocation, "Sheet1", firstcell, "F1048576", False)
If IsArrayDimmed(arrsheet) Then
Dim h
For intCount = 0 To UBound(arrSheet,2)
If (arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60) < 10 Then
h = "0"&(arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60)
Else
h = (arrSheet(3,intCount)-Int(arrSheet(3,intCount)/60)*60)
End If
arrSheet(3,intCount) = Int(arrSheet(3,intCount)/60) & ":" & h
Set SongIterator = SDB.Database.QuerySongs(" SongTitle = '" & Replace(arrSheet(0,intCount),"'","''") & "' AND Album = '" & Replace(arrSheet(2,intCount),"'","''") & "' AND Artist = '" & Replace(arrSheet(1,intCount),"'","''") & "' ")
While Not SongIterator.EOF
Set Song = SongIterator.Item
If Song.SongLengthString = arrSheet(3,intCount) Then
Song.Rating = arrSheet(4,intCount) * 10
If Len(Song.Grouping)=0 And arrSheet(5,intCount) = "on" Then
Song.Grouping = "Instrumental"
ElseIf arrSheet(5,intCount) = "on" And InStr(Song.Grouping,"Instrumental") = 0 Then Song.Grouping = Song.Grouping & "; Instrumental"
End If
End If
Song.UpdateDB
Song.WriteTags
'SongIterator.Item.UpdateAll
SongIterator.Next
Wend
SDB.ProcessMessages
Next
Dim f,g
g = Right(firstcell, Len(firstcell)-1)
Set f = fso.CreateTextFile("c:\users\username\appdata\roaming\mediamonkey\scripts\timestamp.txt", True, True)
f.WriteLine("A"&UBound(arrSheet,2)+1+g)
f.Close
End If
End Sub
Function IsArrayDimmed(arr)
IsArrayDimmed = False
If IsArray(arr) Then
On Error Resume Next
Dim ub : ub = UBound(arr)
If (Err.Number = 0) And (ub >= 0) Then IsArrayDimmed = True
End If
End Function
Function ReadExcel( myXlsFile, mySheet, my1stCell, myLastCell, blnHeader )
' Function : ReadExcel
' Version : 3.00
' This function reads data from an Excel sheet without using MS-Office
'
' Arguments:
' myXlsFile [string] The path and file name of the Excel file
' mySheet [string] The name of the worksheet used (e.g. "Sheet1")
' my1stCell [string] The index of the first cell to be read (e.g. "A1")
' myLastCell [string] The index of the last cell to be read (e.g. "D100")
' blnHeader [boolean] True if the first row in the sheet is a header
'
' Returns:
' The values read from the Excel sheet are returned in a two-dimensional
' array; the first dimension holds the columns, the second dimension holds
' the rows read from the Excel sheet.
'
' Written by Rob van der Woude
' http://www.robvanderwoude.com
Dim arrData( ), i, j
Dim objExcel, objRS
Dim strHeader, strRange
Const adOpenForwardOnly = 0
Const adOpenKeyset = 1
Const adOpenDynamic = 2
Const adOpenStatic = 3
' Define header parameter string for Excel object
If blnHeader Then
strHeader = "HDR=YES;"
Else
strHeader = "HDR=NO;"
End If
' Open the object for the Excel file
Set objExcel = CreateObject( "ADODB.Connection" )
' IMEX=1 includes cell content of any format; tip by Thomas Willig.
' Connection string updated by Marcel Niënkemper to open Excel 2007 (.xslx) files.
objExcel.Open "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & _
myXlsFile & ";Extended Properties=""Excel 12.0;IMEX=1;" & _
strHeader & """"
' Open a recordset object for the sheet and range
Set objRS = CreateObject( "ADODB.Recordset" )
strRange = mySheet & "$" & my1stCell & ":" & myLastCell
objRS.Open "Select * from [" & strRange & "]", objExcel, adOpenStatic
' Read the data from the Excel sheet
i = 0
Do Until objRS.EOF
' Stop reading when an empty row is encountered in the Excel sheet
If IsNull( objRS.Fields(0).Value ) Or Trim( objRS.Fields(0).Value ) = "" Then Exit Do
' Add a new row to the output array
ReDim Preserve arrData( objRS.Fields.Count - 1, i )
' Copy the Excel sheet's row values to the array "row"
' IsNull test credits: Adriaan Westra
For j = 0 To objRS.Fields.Count - 1
If IsNull( objRS.Fields(j).Value ) Then
arrData( j, i ) = ""
Else
arrData( j, i ) = Trim( objRS.Fields(j).Value )
End If
Next
' Move to the next row
objRS.MoveNext
' Increment the array "row" number
i = i + 1
Loop
' Close the file and release the objects
objRS.Close
objExcel.Close
Set objRS = Nothing
Set objExcel = Nothing
' Return the results
ReadExcel = arrData
End Function[/code]