LiveCode Forums

Code: Select all

global gRowCount

on mouseUp
   answer file "Select the Excel file to open" with type "Excel Files|xls,xlsx"
   
   if it is not empty then
      launch document it
      put empty into it
      
      ask "Please enter the number of rows in the spreadsheet."
      if the result is "Cancel" then
         answer "Import Canceled"
         put empty into gRowCount
         exit mouseUp
      else
         if it is empty then
            answer "No information entered."
         else
            put it into gRowCount
            importCSV
         end if
      end if
   else
      answer "Import Canceled"
   end if
end mouseUp

on importCSV
   if gRowCount = "Cancel" then exit importCSV
   else
      
      put GetFromXL("A1:L1") into tHeaders
      put GetFromXL("A2:L" & gRowCount) into tData

      set the itemdel to tab
      set the rowDel to cr
      
      get executeSQL("BEGIN")
      if it is not an integer then
         -- error handling code
         answer "An error occured BEGIN"
         exit importCSV
      end if
      
      repeat with nLines = 1 to gRowCount
         put item 1 of line nLines of tData into SQLArray[1]
         put item 2 of line nLines of tData into SQLArray[2]
         put item 3 of line nLines of tData into SQLArray[3]
         put item 4 of line nLines of tData into SQLArray[4]
         put item 5 of line nLines of tData into SQLArray[5]
         put item 6 of line nLines of tData into SQLArray[6]
         put item 7 of line nLines of tData into SQLArray[7]
         put item 8 of line nLines of tData into SQLArray[8]
         put item 9 of line nLines of tData into SQLArray[9]
         put item 10 of line nLines of tData into SQLArray[10]
         put item 11 of line nLines of tData into SQLArray[11]
         put item 12 of line nLines of tData into SQLArray[12]
         
         put "INSERT into " & tTable & "(FIrst, Middle, Last, Suffix, Spouse, Address, City, State, Zip, Country, HomePhone, CellPhone) "&\
         "VALUES (:1,:2,:3,:4,:5,:6,:7,:8,:9,:10,:11,:12)" into tSQLStatement
         revExecuteSQL the uDatabaseID of this stack, tSQLStatement, "SQLArray"
         
         if the result is not an integer then
            get executeSQL("ROLLBACK")
            -- error handling here
            answer "An error occured ROLLBACK"
            exit importCSV
         end if
         
      end repeat
      
      get executeSQL("COMMIT")
      if the result is an integer then
         populateTheGrid
      end if
   end if
end importCSV

function GetFromXL pRangeRef
   switch (the platform)
      case "MacOS"
         put "tell app" && q("Microsoft Excel") & cr & "get the value of range" && q(pRangeRef) & cr & "end tell" into tScript
         do tScript as AppleScript
         put the result into tData
         
         replace "{{" WITH "{" in tData
         replace "}}" WITH "}" in tData
         replace "}, " WITH ("}" & cr) in tData
         replace ("\" & quote) WITH numtochar(1) in tData
         replace (quote & ", ") WITH tab in tData
         if char 1 of tData = "{" then delete char 1 of tData
         if char -1 of tData = "}" then delete char -1 of tData
         replace ("}" & cr & "{") WITH CR in tData
         replace quote WITH "" in tData
         replace numtochar(1) WITH quote in tData
         return tData
         break
         
      case "Win32"
         put "Dim ObjXL,tNumRows,tNumCols,tRetVal,tRow,tCol" & cr & \
               "Set ObjXL = GetObject(," & q("Excel.Application") & ")" & cr & \
               "tNumRows = ObjXL.Range(" & q(pRangeRef) & ").Rows.Count" & cr & \
               "tNumCols = ObjXL.Range(" & q(pRangeRef) & ").Columns.Count" into tScript
         
         put tScript & cr & "For tRow = 1 To tNumRows" & cr & \
               "For tCol = 1 to tNumCols" & cr & \
               "if tCol <> tNumCols then" & cr & \
               "tRetVal = tRetVal & ObjXL.Range(" & q(pRangeRef) & ").Cells(tRow,tCol).Value & vbTab" & cr &  \
               "else" & cr & \
               "tRetVal = tRetVal & ObjXL.Range(" & q(pRangeRef) & ").Cells(tRow,tCol).Value & vbCrLf" & cr & \
               "end if" & cr & "Next" & cr & "Next" into tScript
         
         put tScript & cr & "tRetVal = Left(tRetVal,Len(tRetVal) - 2)" & cr & "WScript.Echo tRetVal" into tScript
         
         put specialFolderPath("temporary") & "/VBSTemp.vbs" into tFile
         put tScript into url("file:" & tFile)
         set the hideconsolewindows to true
         
         get shell("cscript.exe //nologo" && q(tFile))
         
         send "delete file" && q(tFile) to me in 1 second
         if char -1 of it is CR then delete char -1 of it  -- strip any trailing CR
         return it
         break
   end switch
end GetFromXL

function q pWhat
  return quote & pWhat & quote
end q