When I try to set cell formulas in an existing Excel file via EPPlus, the excel document is corrupted. Excel throws "We found a problem with some content in 'Excel.xlsx'. Do you want us to try to recover as much as we can? If you trust the source of this workbook, click Yes." dialog box, then says, "Removed Records: Formula from /xl/worksheets/sheet1.xml part"
If I comment out the formula set operations, the error goes away, but it fills in with formulas I didn't ask for anywhere in my code.
I have an excel file with several sheets. On one sheet, I want to set a value in column L and set formulas in columns I, J, and M. If I do this manually within Excel, everything works without error. But when I try to automate it, I Get the error messages and lose the formulas.
intended formulas:
Formula for column I: =IFNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$R,12, TRUE),"--")
Formula for column J: =IFNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$S,17,TRUE),"--")
Formula for column M: =IFNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$R,8,TRUE), "--")
Dim Hdr As String = ""
dim serverData as New List (of string) 'a list of data like A1||ServerName
' SNIP <get list data from database.> /SNIP
Dim fInfo As New FileInfo(excelFile)
Using ePack As New ExcelPackage(fInfo)
Dim mySheet As ExcelWorksheet = Nothing
'find the sheet we need.
For Each sheet As ExcelWorksheet In ePack.Workbook.Worksheets
If sheet.Name = ExcelServers Then
mySheet = sheet
Exit For
End If
Next
If IsNothing(mySheet) Then Throw New Exception("Server sheet not found.")
For Each serverRow in ServerData
If IsNothing(serverRow) OrElse InStr(serverRow, "||") = 0 Then Continue For 'skip "blank" rows
Dim Cell() As String = Split(serverRow, "||")
Dim CellAddress As String = Cell(0) 'A1..A50
Dim CellValue As String = Trim(Cell(1)) 'ServerName or table header
Dim CellAddressCol As String = Left(CellAddress, 1) ' Will always be A
Dim CellAddressRow As Integer = CellAddress.Substring(1) 'number, 1-50
If CellValue = "Oracle Server" Then
Hdr = "Ora" 'we've found a list of Oracle servers
Continue For 'skip ahead to the next value
ElseIf CellValue = "SQL Server" Then
Hdr = "Sql" 'we're done with Oracle, moving on to SQL Server servers
Continue For 'skip ahead to the next value
ElseIf CellValue = "Non-DB Servers" Then
Exit For 'we're done with all of our work.
End If
If Hdr = "Ora" Then
If Len(CellValue) < 2 Then
mySheet.Cells("L" & CellAddressRow).Value = ""
Else
mySheet.Cells("L" & CellAddressRow).Value = "P"
End If
ElseIf Hdr = "Sql" Then
If Len(CellValue) < 2 Then
mySheet.Cells("I" & CellAddressRow).Value = ""
mySheet.Cells("J" & CellAddressRow).Value = ""
mySheet.Cells("L" & CellAddressRow).Value = ""
mySheet.Cells("M" & CellAddressRow).Value = ""
ElseIf CellValue = "Cluster1" Or CellValue = "Cluster2" Then
mySheet.Cells("I" & CellAddressRow).Value = ""
mySheet.Cells("J" & CellAddressRow).Value = ""
mySheet.Cells("L" & CellAddressRow).Value = "C"
mySheet.Cells("M" & CellAddressRow).Value = ""
Else 'data row.
mySheet.Cells("I" & CellAddressRow).Formula = "IFNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$R,12, TRUE),""--"")"
mySheet.Cells("J" & CellAddressRow).Formula = "IFNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$S,17,TRUE),""--"")"
mySheet.Cells("L" & CellAddressRow).Value = "V"
mySheet.Cells("M" & CellAddressRow).Formula = "ifNA(VLOOKUP([#[SQL Server]],SqlVersions!$C:$R,8,FALSE),""--"")"
End If ' /empty row? Cluster row? other server row?
End If ' /Oracle or SQL?
Next
ePack.Save()
End Using
I expect to get a series of rows where the rows after "Oracle" get a "P" in column L and the rows after "SQL Server" have lookup formulas in columns I, J, and M, with a "V" in column L.
If I leave the .Formula = code in place, I get the errors. If I comment out the .Formula lines, I instead get the formula "=70+65" for Oracle rows and "=159+799" for SQL Server rows.
The end result should look something like this:
(Note that the Oracle rows and two header rows are just text and aren't modified by this code.)
Oracle Server,,,,,,,,Version,Patch,,P V or C, End of Life
Oracle1,,,,,,,,12.2.0.1,27937914,,P,
Oracle,,,,,,,,12.2.0.1,27937914,,P,
,,,,,,,,
Sql Server,,,,,,,,Version,Patch,,P V or C,End of Life
Cluster1,,,,,,,,,,,C,7/14/2026
Cluster2,,,,,,,,,,C,
Sql1,,,,,,,2016 Ent 13.0.5337,SP2 CU7 Up,,V,10/12/2027
Sql2,,,,,,,2017 Ent 14.0.3223,CU16,,V,7/14/2026
[...]
sql32,,,,,,,2016 Ent 13.0.5426,SP2 CU8,,V,7/14/2016
,,,,,,,,
Non-DB Servers,,,,,,,,
But what I'm getting, after I accept the error message request to repair is:
Oracle Server,,,,,,,,Version,Patch,,P V or C, End of Life
Oracle1,,,,,,,,12.2.0.1,27937914,,135,
Oracle,,,,,,,,12.2.0.1,27937914,,135,
,,,,,,,,,,,135
Sql Server,,,,,,,,Version,Patch,,P V or C,End of Life
Cluster1,,,,,,,,,,958,#N/A
Cluster2,,,,,,,,,,958,#N/A
Sql1,,,,,,,,,,958,10/12/2027
Sql2,,,,,,,,,,958,7/14/2026
[...]
sql32,,,,,,,,,,958,7/14/2016
,,,,,,,,,,958,#N/A
Non-DB Servers,,,,,,,,
I have no idea where those formulas are coming from at all, as they are nowhere in my code, ever.
Edit
Here is the Excel file (scrubbed of actual server names) as it should be.
And here is the Excel file (also scrubbed) as this code leaves it.
When I open and save() the sample you provided, without doing any edit whatsoever, it always shows me the problem with some content error (tried on Windows 10 with Office 365 and .NET 4.7.2). Because of this I cannot be certain of the cause in your specific situation.
However, I notice EPPlus has a problem when 'translating' formulae when using a Table within Excel. As an example a simple vlookup:
=VLOOKUP(A2,Data!A:B,2,FALSE)
When the above formula is used in a Table, it is changed after being saved with EPPlus and is now erroneous (showing #NAME?) because of the A:B:B:
=VLOOKUP(A2,Data!A:B:B,2,FALSE)
Finding out if this is a bug in EPPlus will require some extensive debugging, with the ExcelCellBase.Translate method being a good start. Also, someone else might already have found it (EPPlus has an relatively large list of open issues.
Sorry if this does not help. I think what I showed is a bug in EPPlus, but I do now know if it it the cause for your problem.
I have been tasked with creating and updating a series of VBA based excel add-on programs by my superiors at work. One of the programs is a utility that compares the contents of two folders and gives a list of what files are different. Most of the program works very well, but I am having issues with one section of the code; namely, the section that is tasked with gathering all the filenames of the files to be checked.
The section itself does function, most of the time with no issue, but on occasion, it will take inordinate amounts of time. I have been running the tests on the same set of data for the entire development of the utility, so I know that the issue is not the number of files being searched (which is in the hundreds and will eventually be nearly the thousands). My issue is that the section of code is wildly inconsistent with its timing.
The section of code in question is here:
Sub GetFileList(ByRef FileSpec() As String, FileArray() As FileInfo, FoldIndex As Integer)
'FileSpec - an array of strings that correspond to the filtered list of file extensions to be searched
'FileArray - an array of strings that will end up holding the complete list of relevant file names
'FoldIndex - an integer that corresponds to which folder is being searched (1 or 2)
'Returns an array of filenames that match FileSpec
'If no matching files are found, returns an error messagebox
'Arbitrarly takes inordinate amount of time, sometimes upwards of 20 seconds, to finish running.
'Usually when the filtering has been changed.
Dim FileCount As Integer
Dim FileName As String
On Error GoTo NoFilesFound
FileCount = 0
For i = LBound(FileSpec) + 1 To UBound(FileSpec)
FileName = Dir(FileSpec(i))
'Loop until no more matching files are found
Do While FileName <> ""
FileCount = FileCount + 1
ReDim Preserve FileArray(1 To FileCount)
FileArray(FileCount).FileName = FileName
FileName = Dir()
Select Case FoldIndex
Case 1
Call FormFunctionality.UpdateResults(FileCount & ": " & FileArray(FileCount).FileName & vbCrLf, "")
Case 2
Call FormFunctionality.UpdateResults("", FileCount & ": " & FileArray(FileCount).FileName & vbCrLf)
End Select
Loop
Next i
If FileCount = 0 Then GoTo NoFilesFound
Exit Sub
'Error handler
NoFilesFound:
ReDim FileArray(1)
FileArray(1).FileName = "Error"
MsgBox ("Error: No files found of requested type" & vbCrLf & "Please review folders and requested file types.")
End
End Sub
Sub UpdateResults(Str1 As String, Str2 As String)
'Prints strings to the results window text boxes
RbtUtilResultScreen.Folder1Results.Text = RbtUtilResultScreen.Folder1Results.Text & Str1
RbtUtilResultScreen.Folder2Results.Text = RbtUtilResultScreen.Folder2Results.Text & Str2
RbtUtilResultScreen.Folder1Results.SetFocus
RbtUtilResultScreen.Folder2Results.SetFocus
End Sub
The Time inconsistency varies wildly. For ~350 files being searched, the average time to generate the list of files is about 2 seconds. Sometimes, that time shoots up to 10 or 20 seconds, which is frankly unacceptable. It gets even worse with more files being searched, and I have had it take up to a minute and thirty seconds for ~800 files (where the average is still something like 3 seconds).
My question is this: Is there something obvious that I am doing wrong, or is there a better way to handle reading files in that I have overlooked? What could be causing this inconsistency within the program?
If more in-depth timing information or other sections of the code are needed, I will provide. I do not believe that I can provide access to the data that I have been running the tests on, though.
A reason is not clear from your code. However, you can optimize some part and maybe that reduces the time. Namely, you ReDim on each iteration and this can cause memory management overhead. Instead, ReDim a fixed number of items, for example:
Dim nElms As Integer
...
nElms = 0
FileCount = 0
Do While FileName <> ""
FileCount = FileCount + 1
If (FileCount > nElms) Then
nElms = nElms + 250
ReDim Preserve FileArray(1 To nElms)
EndIf
Paul has suggested in his response that you need to use "fixed step" to re-dimension the array which seems to be one issue.
The other issue seems to be updating the form text continuously to show progress. If it is not too critical then you can think of changing it to something like below.
Declare dictionary object at the beginning of code before Loop.
Dim objDict As Object
objDict = CreateObject("Scripting.Dictionary")
And then modified block would be like shown below.
For i = LBound(FileSpec) + 1 To UBound(FileSpec)
FileName = Dir(FileSpec(i))
objDict.RemoveAll
Do While FileName <> ""
If Not objDict.Exists(FileName) Then objDict.Add FileName, FileName
FileName = Dir()
Loop
Select Case FoldIndex
Case 1
Call FormFunctionality.UpdateResults(objDict.Count & ": " & FileName & vbCrLf, "")
Case 2
Call FormFunctionality.UpdateResults("", objDict.Count & ": " & FileName & vbCrLf)
End Select
Next I
Test it on a backup!
I have an Excel sheet with almost 30.000 words in column A and I want to create a macro to search each word in Google Translate, get their meaning (or translation), put the meaing in column B (or if there is more than more meaning in column C, column D, etc.)
Since I have almost 30.000 words, it is a very time consuming thing to search for each word by myself. It would be great if I can do this with a macro.
Any suggestions? (Google Translate is not a "must" for me. If there is another web-site or some other way to do this, I am open to suggestions)
Note: I came across with this topic, but it did not work out the way I hoped.
Since the Google Translate API is not the free service it's tricker to perform this operation. However, I found a workaround on this page Translate text using vba and I made some adjustments so it could work for your purposes. Assuming that the original words are entered into the "A" column in the spreadsheet and translations should appear in the colums on the right here is the code:
Sub test()
Dim s As String
Dim detailed_translation_results, basic_translation_results
Dim cell As Range
For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
If cell.Value <> "" Then
detailed_translation_results = detailed_translation(cell.Value)
'Check whether detailed_translation_results is an array value. If yes, each detailed translation is entered into separate column, if not, basic translation is entered into the next column on the right
On Error Resume Next
ActiveSheet.Range(cell.Offset(0, 1), cell.Offset(0, UBound(detailed_translation_results) + 1)).Value = detailed_translation_results
If Err.Number <> 0 Then
cell.Offset(0, 1).Value = detailed_translation_results
End If
On Error GoTo 0
End If
Next cell
End Sub
Function detailed_translation(str)
' Tools Refrence Select Microsoft internet Control
Dim IE As Object, i As Long, j As Long
Dim inputstring As String, outputstring As String, text_to_convert As String, result_data As String, CLEAN_DATA
Dim FirstTablePosition As Long, FinalTablePosition
Set IE = CreateObject("InternetExplorer.application")
' Choose input language - Default "auto"
inputstring = "auto"
' Choose input language - Default "en"
outputstring = "en"
text_to_convert = str
'open website
IE.Visible = False
IE.navigate "http://translate.google.com/#" & inputstring & "/" & outputstring & "/" & text_to_convert
Do Until IE.ReadyState = 4
DoEvents
Loop
Application.Wait (Now + TimeValue("0:00:5"))
Do Until IE.ReadyState = 4
DoEvents
Loop
'Firstly, this function tries to extract detailed translation.
Dim TempTranslation() As String, FinalTranslation() As String
FirstTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "<tbody>")
LastTablePosition = InStr(IE.Document.getElementById("gt-lc").innerHTML, "</tbody>")
On Error Resume Next
TempTranslation() = Split(Mid(IE.Document.getElementById("gt-lc").innerHTML, FirstTablePosition, LastTablePosition - FirstTablePosition), "class=""gt-baf-cell gt-baf-word-clickable"">")
ReDim FinalTranslation(0 To UBound(TempTranslation) - 1)
For j = LBound(TempTranslation) + 1 To UBound(TempTranslation)
FinalTranslation(j - 1) = Left(TempTranslation(j), InStr(TempTranslation(j), "<") - 1)
Next j
On Error GoTo 0
Dim CheckIfDetailed
'Check whether there is detailed translation available. If not - this function returns a single translation
On Error Resume Next
CheckIfDetailed = FinalTranslation(LBound(FinalTranslation))
If Err.Number <> 0 Then
CLEAN_DATA = Split(Application.WorksheetFunction.Substitute(IE.Document.getElementById("result_box").innerHTML, "</SPAN>", ""), "<")
For j = LBound(CLEAN_DATA) To UBound(CLEAN_DATA)
result_data = result_data & Right(CLEAN_DATA(j), Len(CLEAN_DATA(j)) - InStr(CLEAN_DATA(j), ">"))
Next
detailed_translation = result_data
Exit Function
End If
On Error GoTo 0
IE.Quit
detailed_translation = FinalTranslation()
End Function
Please note that the code is extremly slow (due to anti-robot restrictions) and I cannot guarantee that Google will not block the script. However, it should work.
The only thing you should do is to choose languages in the places marked by the appropriate comment.
Alternatively, if you seek something faster, you can manipulate Application.Wait method (for example setting the value to 0:00:2 instead of 0:00:5) or google for Microsoft Translate.