krishnaoptif
Board Regular
- Joined
- Sep 17, 2010
- Messages
- 140
Hi Experts,
I get below error msg sometime when i open my excel file which has vba code in it.
Error msg: "We found a problem with some content in 'my excel file.xlsb'. Do you want us to try to recover as much as we can? If you trust the source of this workbook, Click Yes."
then i always click on yes button and then save as this file again. It also give me one dialog box where show a xml file path.
I am using below VBA code in my this Excel file.
I get below error msg sometime when i open my excel file which has vba code in it.
Error msg: "We found a problem with some content in 'my excel file.xlsb'. Do you want us to try to recover as much as we can? If you trust the source of this workbook, Click Yes."
then i always click on yes button and then save as this file again. It also give me one dialog box where show a xml file path.
I am using below VBA code in my this Excel file.
Code:
Option Explicit
'Production
Const SharePointUrl = "http://Mysite/TeamSite/"
Const ListNameOrGuid = "{C6946GC2-1433-4244-94D5-A9EE449E480F}"
Const ViewNameOrGuid = "{BD08G78A-6E68-480D-8B51-14F0030F6106}"
Sub ImportSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, strViewNameOrGuid As String, SheetName As String)
'=======================================================================
' Variable ini and get data into sheet from sharepoint
'=======================================================================
Dim objMyList As ListObject
Dim objWksheet As Worksheet
Set objWksheet = Worksheets(SheetName)
objWksheet.Visible = True
objWksheet.Activate
objWksheet.Cells.Delete
Set objMyList = objWksheet.ListObjects.Add(xlSrcExternal, Array(StrSharePointUrl & "/_vti_bin", strListNameOrGuid, strViewNameOrGuid), False, , Range("A1"))
'Set objWksheet = Nothing
'objWksheet.Visible = False
End Sub
Sub Download_SPlist()
Call ImportSharePointList(SharePointUrl, ListNameOrGuid, ViewNameOrGuid, Sht_SP.Name)
End Sub
Sub SyncDataToSharePoint()
Sht_Instructions.Range("F14").Value = Now()
'=======================================================================
' Variable ini
'=======================================================================
Dim lRow As Long
Dim str As String
Dim str_RecordID As String
Dim str_CSR As String
Dim str_CODate As String
Dim str_InforCO As String
Dim str_Cust As String
Dim str_CustName As String
Dim str_OrderValue As String
Dim str_CustPO As String
Dim str_COShipDate As String
Dim str_WHCode As String
Dim str_OrderStatus As String
Dim str_OrderHeld As String
lRow = 2
str = Sht_SyncToSP.Cells(lRow, 1).Value
While str <> ""
'=======================================================================
' Delete Item from the SharePoint List
'=======================================================================
If str = "Not in Open & Closed Infor" Then
Call Delete_ItemInSharePointList(SharePointUrl, ListNameOrGuid, Sht_SyncToSP.Cells(lRow, 2).Value)
ElseIf str = "New" Or str = "New+Hold" Then
'=======================================================================
' Add Item into the SharePoint List
'=======================================================================
str_CSR = Replace(Sht_SyncToSP.Cells(lRow, 3).Value, "&", "&")
str_CODate = Sht_SyncToSP.Cells(lRow, 4).Value
str_InforCO = Sht_SyncToSP.Cells(lRow, 5).Value
str_Cust = Sht_SyncToSP.Cells(lRow, 6).Value
str_CustName = Replace(Sht_SyncToSP.Cells(lRow, 7).Value, "&", "&")
str_OrderValue = Sht_SyncToSP.Cells(lRow, 8).Value
str_CustPO = Replace(Sht_SyncToSP.Cells(lRow, 9).Value, "&", "&")
str_COShipDate = Sht_SyncToSP.Cells(lRow, 10).Value
str_WHCode = Sht_SyncToSP.Cells(lRow, 11).Value
str_OrderStatus = Replace(Sht_SyncToSP.Cells(lRow, 12).Value, "&", "&")
str_OrderHeld = Sht_SyncToSP.Cells(lRow, 13).Value
Call Add_ItemInSharePointList(SharePointUrl, ListNameOrGuid, str_CSR, str_CODate, str_InforCO, str_Cust, str_CustName, str_OrderValue, str_CustPO, str_COShipDate, str_WHCode, str_OrderStatus, str_OrderHeld)
Else
'=======================================================================
' Add Item into the SharePoint List
'=======================================================================
str_RecordID = Sht_SyncToSP.Cells(lRow, 2).Value
str_CSR = Replace(Sht_SyncToSP.Cells(lRow, 3).Value, "&", "&")
str_CODate = Sht_SyncToSP.Cells(lRow, 4).Value
str_InforCO = Sht_SyncToSP.Cells(lRow, 5).Value
str_Cust = Sht_SyncToSP.Cells(lRow, 6).Value
str_CustName = Replace(Sht_SyncToSP.Cells(lRow, 7).Value, "&", "&")
str_OrderValue = Sht_SyncToSP.Cells(lRow, 8).Value
str_CustPO = Replace(Sht_SyncToSP.Cells(lRow, 9).Value, "&", "&")
str_COShipDate = Sht_SyncToSP.Cells(lRow, 10).Value
str_WHCode = Sht_SyncToSP.Cells(lRow, 11).Value
str_OrderStatus = Replace(Sht_SyncToSP.Cells(lRow, 12).Value, "&", "&")
str_OrderHeld = Sht_SyncToSP.Cells(lRow, 13).Value
Call Update_ItemInSharePointList(SharePointUrl, ListNameOrGuid, str_RecordID, str_CSR, str_CODate, str_InforCO, str_Cust, str_CustName, str_OrderValue, str_CustPO, str_COShipDate, str_WHCode, str_OrderStatus, str_OrderHeld)
End If
lRow = lRow + 1
str = Sht_SyncToSP.Cells(lRow, 1).Value
Wend
Sht_Instructions.Range("G14").Value = Now()
End Sub
Sub Delete_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, RecordID As String)
'=======================================================================
' Variable ini
'=======================================================================
Dim objXMLHTTP As MSXML2.XMLHTTP
'Dim objXMLHTTP As Object
Dim strBatchXml As String
Dim strSoapBody As String
'=======================================================================
' Create new object
'=======================================================================
Set objXMLHTTP = New MSXML2.XMLHTTP
'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
'=======================================================================
' Delete item with internal ID
'=======================================================================
'strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Delete'><Field Name='ID'>" + RecordID + "</Field></Method></Batch>"
strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Delete'><Field Name='ID'>" + RecordID + "</Field></Method></Batch>"
objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
& "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
& "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
& "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
& "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
objXMLHTTP.send strSoapBody
'If objXMLHTTP.Status = 200 Then
' Do something with response
'End If
Set objXMLHTTP = Nothing
End Sub
Sub Add_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, str_CSR As String, str_CODate As String, str_InforCO As String, str_Cust As String, str_CustName As String, str_OrderValue As String, str_CustPO As String, str_COShipDate As String, str_WHCode As String, str_OrderStatus As String, str_OrderHeld As String)
'=======================================================================
' Variable ini
'=======================================================================
'Dim objXMLHTTP As Object
Dim objXMLHTTP As MSXML2.XMLHTTP
Dim strBatchXml, strBatchXml2 As String
Dim strSoapBody As String
'=======================================================================
' Set obj
'=======================================================================
Set objXMLHTTP = New MSXML2.XMLHTTP
'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
strListNameOrGuid = strListNameOrGuid
'=======================================================================
' Add a new item
'=======================================================================
strBatchXml = "<Batch OnError='Continue'><Method ID='3' Cmd='New'><Field Name='ID'>New</Field><Field Name='CSR'>" + str_CSR + "</Field><Field Name='CO_x0020_Date'>" + Format(CDate(str_CODate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='Title'>" + str_InforCO + "</Field><Field Name='Cust_x0023_'>" + str_Cust + "</Field><Field Name='Cust_x0020_Name'>" + str_CustName + "</Field><Field Name='Order_x0020_Value'>" + str_OrderValue + "</Field><Field Name='Cust_x0020_PO_x0023_'>" + str_CustPO + "</Field><Field Name='CO_x0020_Ship_x0020_Date'>" + Format(CDate(str_COShipDate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='WH_x0020_Code'>" + str_WHCode + "</Field><Field Name='Order_x0020_Status'>" + str_OrderStatus + "</Field><Field Name='Order_x0020_Held'>" + str_OrderHeld + "</Field></Method></Batch>"
objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
& "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
& "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
& "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
& "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
objXMLHTTP.send strSoapBody
If objXMLHTTP.Status = 200 Then
'Do something with response
End If
Set objXMLHTTP = Nothing
End Sub
Sub Update_ItemInSharePointList(StrSharePointUrl As String, strListNameOrGuid As String, RecordID As String, str_CSR As String, str_CODate As String, str_InforCO As String, str_Cust As String, str_CustName As String, str_OrderValue As String, str_CustPO As String, str_COShipDate As String, str_WHCode As String, str_OrderStatus As String, str_OrderHeld As String)
'=======================================================================
' Variable ini
'=======================================================================
'Dim objXMLHTTP As Object
Dim objXMLHTTP As MSXML2.XMLHTTP
Dim strBatchXml, strBatchXml2 As String
Dim strSoapBody As String
'=======================================================================
' Set obj
'=======================================================================
Set objXMLHTTP = New MSXML2.XMLHTTP
'Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
strListNameOrGuid = strListNameOrGuid
'=======================================================================
' Add a new item
'=======================================================================
strBatchXml = "<Batch OnError='Continue'><Method ID='1' Cmd='Update'><Field Name='ID'>" + RecordID + "</Field><Field Name='CSR'>" + str_CSR + "</Field><Field Name='CO_x0020_Date'>" + Format(CDate(str_CODate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='Title'>" + str_InforCO + "</Field><Field Name='Cust_x0023_'>" + str_Cust + "</Field><Field Name='Cust_x0020_Name'>" + str_CustName + "</Field><Field Name='Order_x0020_Value'>" + str_OrderValue + "</Field><Field Name='Cust_x0020_PO_x0023_'>" + str_CustPO + "</Field><Field Name='CO_x0020_Ship_x0020_Date'>" + Format(CDate(str_COShipDate), "yyyy-mm-dd HH:MM:SS") + "</Field><Field Name='WH_x0020_Code'>" + str_WHCode + "</Field><Field Name='Order_x0020_Status'>" + str_OrderStatus + "</Field><Field Name='Order_x0020_Held'>" + str_OrderHeld + "</Field></Method></Batch>"
objXMLHTTP.Open "POST", StrSharePointUrl + "_vti_bin/Lists.asmx", False
objXMLHTTP.setRequestHeader "Content-Type", "text/xml; charset=""UTF-8"""
objXMLHTTP.setRequestHeader "SOAPAction", "http://schemas.microsoft.com/sharepoint/soap/UpdateListItems"
strSoapBody = "<soap:Envelope xmlns:xsi='http://www.w3.org/2001/XMLSchema-instance' " _
& "xmlns:xsd='http://www.w3.org/2001/XMLSchema' " _
& "xmlns:soap='http://schemas.xmlsoap.org/soap/envelope/'><soap:Body><UpdateListItems " _
& "xmlns='http://schemas.microsoft.com/sharepoint/soap/'><listName>" & strListNameOrGuid _
& "</listName><updates>" & strBatchXml & "</updates></UpdateListItems></soap:Body></soap:Envelope>"
objXMLHTTP.send strSoapBody
If objXMLHTTP.Status = 200 Then
'Do something with response
End If
Set objXMLHTTP = Nothing
End Sub