i want to rename my file. But i got a IOException. It says "The Process Cannot Access the File Because It Is Being Used by Another Process".
This is my Code:
asp.net:
<telerik:RadAsyncUpload ID="rauKachelUpload" runat="server" ChunkSize="0" Localization-Cancel="Löschen" Localization-Remove="Entfernen" Localization-Select="Auswählen"
Culture="de-DE" Skin="MetroTouch" MaxFileInputsCount="1" OnFileUploaded="rauKachelUpload_FileUploaded">
</telerik:RadAsyncUpload>
vb.net:
Protected Sub rauKachelUpload_FileUploaded(sender As Object, e As FileUploadedEventArgs)
Try
Using fileStream As Stream = e.File.InputStream
Using img As System.Drawing.Image = System.Drawing.Image.FromStream(fileStream)
Dim h As Integer = img.Height
Dim w As Integer = img.Width
img.Dispose()
Dim fileName As String = e.File.GetName()
If w = MaxWidth And h = MaxHeight Then
rauKachelUpload.TargetFolder = "img/kachel_grafik"
Dim TimeStamp As String = DateDiff("s", "01/1/1970 12:00:00 AM", DateTime.Now)
fileName = "KI_" & TimeStamp & WelcheSparteUndGröße
KachelPfad = "~/img/kachel_grafik/" & fileName
Else
KachelFalsch = True
End If
If KachelFalsch = False Then
e.File.SaveAs(fileName)
Page.ClientScript.RegisterClientScriptBlock([GetType](), "CloseScript", "redirectParentPage('VermittlerBearbeiten.aspx?ID=" & VermittlerID & "&KBFN=" & KachelPfad & "&NA=true" & "&fwg=" & WelcheSparteUndGröße & "&Ang1=" & hfAng1CHK.Value & "&Ang2=" & hfAng2CHK.Value & "&Ang3=" & hfAng3CHK.Value & "&Ang4=" & hfAng4CHK.Value & "&AngSrc1=" & hfKachelIMGSrcBaufi.Value & "&AngSrc2=" & hfKachelIMGSrcImmo.Value & "&AngSrc3=" & hfKachelIMGSrcPhoto.Value & "&AngSrc4=" & hfKachelIMGSrcAsse.Value & "');", True)
Else
rnfIconNichtErzeugt.Visible = True
End If
End Using
End Using
Catch ex As Exception
rnfIconNichtErzeugt.Visible = True
End Try
End Sub
Without trying to rename my file, it works fine.
Does anyone has an Idea what i did wrong?
Thanks for reading.
Daniel
You need to make sure that the fileStream is properly closed before attempting to rename the file since the particular file will be held by the fileStream object. You can try fileStream.Close() after the img.Dispose() statement.
Related
This question already has answers here:
What is an IndexOutOfRangeException / ArgumentOutOfRangeException and how do I fix it?
(5 answers)
Closed 4 years ago.
I am running a VB.NET program and having an error of
"Index was out of range. Must be non-negative and less than the
size of the collection. Parameter name: index"
My code looks like below:
Protected Sub gvadmin_RowCommand(sender As Object, e As GridViewCommandEventArgs) Handles gv_admin.RowCommand
Dim index As Integer = Convert.ToInt32(e.CommandArgument)
Dim row As GridViewRow = gv_admin.Rows(index)
If (e.CommandName = "viewdoc") Then
Dim revno As String = gv_admin.DataKeys(index).Values(0).ToString()
Dim dept As String = gv_admin.DataKeys(index).Values(1).ToString()
Dim ki As String = gv_admin.DataKeys(index).Values(2).ToString()
Dim url As String = "ScheduleViewDoc.aspx"
Dim s As String = "window.open('" & url & "?" & "revno=" & revno & "&eqdept=" & dept & "&ki=" & ki & "', 'popup_window', 'width=1450,height=700,left=10,top=10,resizable=no');"
ClientScript.RegisterStartupScript(Me.GetType(), "script", s, True)
BindGrid1()
ElseIf (e.CommandName = "viewstatus") Then
Dim eqstatus As String = gv_admin.DataKeys(index).Values(3).ToString()
'Dim url As String = "MasterlistViewStatus.aspx"
'Dim s As String = "window.open('" & url & "?" & "eqstatus=" & status & "', 'popup_window', 'width=450,height=500,left=10,top=10,resizable=no');"
'ClientScript.RegisterStartupScript(Me.GetType(), "script", s, True)
liststatus(eqstatus)
mpstatus.Show()
BindGrid1()
End If
End Sub
The error --> Dim row As GridViewRow = gv_admin.Rows(index)
This code has no checks for exceptions. You should always check if the index is valid in your case. Add a check for index. I am not that good in vb. Something like:
if(index < 0) return;
Before getting the rows based on index.
Also, write a check for e.CommandArgument. It is always safer to have these checks in you code
I need to copy a range from an Excel file into Outlook, then send it as an email. It needs to be embedded into the email itself. I found this code which works great, with one exception: It is centering the range in the middle of the "page" in outlook, and I need it to align to the left.
I am assuming this is done in HTML but I do not know that language. Here is the code I am using:
Option Explicit
Public Sub prcSendMail()
Dim objOutlook As Object, objMail As Object
Set objOutlook = CreateObject(Class:="Outlook.Application")
Set objMail = objOutlook.CreateItem(0)
With objMail
.To = "Mike.Marshall#worldpay.us"
.Subject = "Hallo"
.HTMLBody = fncRangeToHtml("Summary", "B2:G26")
.Display 'zum testen
' .Send
End With
Set objMail = Nothing
Set objOutlook = Nothing
End Sub
Private Function fncRangeToHtml( _
strWorksheetName As String, _
strRangeAddress As String) As String
Dim objFilesytem As Object, objTextstream As Object, objShape As Shape
Dim strFilename As String, strTempText As String
Dim blnRangeContainsShapes As Boolean
strFilename = Environ$("temp") & "\" & _
Format(Now, "dd-mm-yy_h-mm-ss") & ".htm"
ThisWorkbook.PublishObjects.Add( _
SourceType:=xlSourceRange, _
Filename:=strFilename, _
Sheet:=strWorksheetName, _
Source:=strRangeAddress, _
HtmlType:=xlHtmlStatic).Publish True
Set objFilesytem = CreateObject("Scripting.FileSystemObject")
Set objTextstream = objFilesytem.GetFile(strFilename).OpenAsTextStream(1, -2)
strTempText = objTextstream.ReadAll
objTextstream.Close
For Each objShape In Worksheets(strWorksheetName).Shapes
If Not Intersect(objShape.TopLeftCell, Worksheets( _
strWorksheetName).Range(strRangeAddress)) Is Nothing Then
blnRangeContainsShapes = True
Exit For
End If
Next
If blnRangeContainsShapes Then _
strTempText = fncConvertPictureToMail(strTempText, Worksheets(strWorksheetName))
fncRangeToHtml = strTempText
Set objTextstream = Nothing
Set objFilesytem = Nothing
Kill strFilename
End Function
Public Function fncConvertPictureToMail(strTempText As String, objWorksheet As Worksheet) As String
Const HTM_START = "<link rel=File-List href="
Const HTM_END = "/filelist.xml"
Dim strTemp As String
Dim lngPathLeft As Long
lngPathLeft = InStr(1, strTempText, HTM_START)
strTemp = Mid$(strTempText, lngPathLeft, InStr(lngPathLeft, strTempText, ">") - lngPathLeft)
strTemp = Replace(strTemp, HTM_START & Chr$(34), "")
strTemp = Replace(strTemp, HTM_END & Chr$(34), "")
strTemp = strTemp & "/"
strTempText = Replace(strTempText, strTemp, Environ$("temp") & "\" & strTemp)
fncConvertPictureToMail = strTempText
End Function
Is there some code to left align the range I am copying into Outlook?
I have W7 x64, Excel 2013 and Outlook 2013.
Thanks!
add this after your objTextstream.Close
strTempText = Replace(strTempText, "align=center x:publishsource=", "align=left x:publishsource=")
This worked for me
With objMail
.To = "Bofa#deeznutz.com"
.cc = ""
.Subject = "BR1 Summary for Adjustments +/- >$250"
.HTMLBody = "<table width='100'><tr><td align=left>" + fncRangeToHtml("weekly adjustments report", Sheet1.UsedRange.Address) + "</td></tr></table>" & "<br>" & "<b>" & "<font size=4>" & "Adjustments +/- >$250" & "</font>" & "</b>" & fncRangeToHtml("Sheet1", Sheet2.UsedRange.Address)
VBA likes the quotes and the spaces. but in that last line of code you can either quote all of you HTML functions or break it up. but once you are finished using that like bold, you have to "/function" to end it before it likes the information. the & and + work the same.
I have a function that writes from ASP.net to EXCEL using worksheet VBA coding, where I export the datatable and modify every Excel cell the way I want to.
But I have a problem : On Export, i want to ask the user if he wants to Open or Save the file
I wrote this code, the Open / Save As pop-up didn't work :
(I found code that exports the data table to excel without design but I want my report to be better organized)
Sub WriteToExcel(ByVal DATE1 As String, ByVal DATE2 As String)
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Dim DT As New DataTable
Dim filename As String = "Report-" & Date.Now.ToShortDateString.Replace("/", "-") & " " & Date.Now.ToShortTimeString.Replace(":", "-") & ".xls"
Try
DT = Session("datatable")
If DT.Rows.Count > 0 Then
oExcel = CreateObject("Excel.Application")
oBook = oExcel.Workbooks.Add
oSheet = oBook.Worksheets(1)
oSheet.Range("D1").Value = "Service Based Daily/Monthly Revenu"
oSheet.Range("D1").Font.Bold = True
oSheet.Range("D1").font.size = 13
oSheet.Range("D2").Value = "From " & DATE1 & " to " & DATE2
oSheet.Range("D2").Font.Bold = True
oSheet.Range("D2").font.size = 13
oSheet.Range("D1:E1:F1").MergeCells = True
oSheet.Range("D2:E2:F2").MergeCells = True
oSheet.Range("B4").Value = "Report Build Time: " & Date.Now.ToShortDateString & " " & Date.Now.ToShortTimeString
oSheet.Range("B4").Font.Bold = False
oSheet.Range("B4").font.size = 11
oSheet.Range("B4:C4:D4:E4").Interior.Color = RGB(200, 200, 172)
oSheet.Range("B4:C4:D4:E4").MergeCells = True
oSheet.Range("B6").Value = "Service Name"
oSheet.Range("C6").Value = "Hits"
oSheet.Range("D6").Value = "Revenue"
oSheet.Range("E6").Value = "Service Cost"
With oSheet.Range("B6:C6:D6:E6")
.Font.Bold = True
.font.size = 13
.font.Color = RGB(0, 0, 0)
.Interior.Color = RGB(70, 134, 196)
.HorizontalAlignment = -4108
.VerticalAlignment = -4108
.WrapText = False
.Orientation = 0
.AddIndent = False
.IndentLevel = 0
.ShrinkToFit = False
.EntireColumn.ColumnWidth = 20
.MergeCells = False
End With
Dim i As Integer = 7
For Each dRow As DataRow In DT.Rows
oSheet.Range("B" & i).Value = dRow("Service_Name").ToString()
oSheet.Range("C" & i).Value = dRow("Hits").ToString()
oSheet.Range("D" & i).Value = dRow("Revenue").ToString()
oSheet.Range("E" & i).Value = dRow("Service_Cost").ToString()
oSheet.Range("B" & i & ":C" & i & ":D" & i & ":E" & i).HorizontalAlignment = -4108
oSheet.Range("B" & i & ":C" & i & ":D" & i & ":E" & i).VerticalAlignment = -4108
i += 1
Next
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader("Content-Disposition", "inline; filename=" & filename)
Response.BinaryWrite(oExcel)
oBook = Nothing
oExcel.Quit()
oExcel = Nothing
GC.Collect()
End If
End Sub
I want to change this part :
Response.ContentType = "application/vnd.ms-excel"
Response.AddHeader("Content-Disposition", "inline; filename=" & filename)
Response.BinaryWrite(oExcel)
I want the user to choose where he wants to save the file. Any suggestion?
You should be able to force the save as dialogue by using attachment rather than inline.
Response.Clear
Response.AddHeader("Content-Disposition", "attachment; filename=" & filename)
How to modify a VB script to archive event logs? I found one VB script working just fine to archive event logs to a network share folder, but I am not sure where to modify the VB script to:
Only collect system, application and security logs not all logs
How to make these archive logs with month, date and year and save them to the same folder daily and not overwrite them.
You need to change this line ("Select * from Win32_NTEventLogFile") Example
("Select * from Win32_NTEventLogFile where LogFileName='Application'")
Add in filter for the logs you wish to backup see http://social.technet.microsoft.com/Forums/scriptcenter/en-US/febbb896-e7fb-42c6-9b1b-6f3e3b293b22/event-viewer-log-script-only-working-for-application-event-log
OR
http://www.activexperts.com/activmonitor/windowsmanagement/scripts/logs/event/
This should help you.
See the following altered code for your requirements, will output required logs and save to a different folder each day.
VBS
Dim strComputer, objDir2
Dim current: current = Now
Dim strDateStamp: strDateStamp = dateStamp(current)
strComputer = "YourServer"
objDir2 = "Your File Server Path" & strDateStamp
Dim objDir1: objDir1 = "\\" & strComputer & "\c$\EVT"
clearEVTLogs = "No"
Set filesys=CreateObject("Scripting.FileSystemObject")
If Not filesys.FolderExists(objDir1) Then
createDir(objDir1)
If Not filesys.FolderExists(objDir2) Then
createDir(objDir2)
End If
strPath = objDir2 & "\"
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate, (Backup, Security)}!\\" _
& strComputer & "\root\cimv2")
Set colLogFiles = objWMIService.ExecQuery _
("Select * from Win32_NTEventLogFile where LogFileName='Application' Or LogFileName='Security' Or LogFileName='System'")
For Each objLogfile In colLogFiles
strCopyFile = strDateStamp & "_" & strComputer & "_" _
& objLogFile.LogFileName & ".evt"
strBackupFile = "c:\EVT\" & strDateStamp & "_" _
& strComputer & "_" & objLogFile.LogFileName & ".evt"
strBackupLog = objLogFile.BackupEventLog _
(strBackupFile)
Call copyAFile(objDir1, strPath, strCopyFile)
If clearEVTLogs = "Yes" Then
objLogFile.ClearEventLog()
End If
Next
Function dateStamp(ByVal dt)
Dim y, m, d
y = Year(dt)
m = Month(dt)
If Len(m) = 1 Then m = "0" & m
d = Day(dt)
If Len(d) = 1 Then d = "0" & d
dateStamp = y & m & d
End Function
Function copyAFile( Byval strSourceFolder, Byval strTargetFolder, _
Byval strFileName)
Dim objFSO, booOverWrite, strResult
Set objFSO = CreateObject( "Scripting.FileSystemObject")
If objFSO.FileExists( strSourceFolder & "\" & strFileName) _
And UCase( strSourceFolder) <> UCase( strTargetFolder) Then
If objFSO.FolderExists( strTargetFolder) Then
Else
strResult = "The destination folder does not exist!"
'copyAFile = strResult
Exit Function
End If
If objFSO.FileExists( strTargetFolder & "\" & strFileName) Then
strResult = "The file exists, overwritten"
booOverWrite = vbTrue
Else
strResult = "The file does not exist, created"
booOverWrite = vbFalse
End If
objFSO.CopyFile strSourceFolder & "\" _
& strFileName, strTargetFolder & "\", booOverWrite
Else
strResult = "The source file does not exist, or " _
& "identical Source and Target folders!"
End If
End Function
Function createDir(strDir)
Set filesys=CreateObject("Scripting.FileSystemObject")
Set objFSO = CreateObject("Scripting.FileSystemObject")
wscript.echo strDir
If Not filesys.FolderExists(strDir) Then
Set objFolder = objFSO.CreateFolder(strDir)
End If
End Function
Would I just use MSXML and import as binary? Or is there another more efficient way?
There are gigs and gigs of JPEGs to fetch.
I have written something in the past, the code below will save remote image on the server disk. It's classic ASP and pretty efficient:
<%
Const CONTENT_FOLDER_NAME = "StoredContents"
Dim strImageUrl
strImageUrl = "http://www.gravatar.com/avatar/8c488f9c3d3da5bb756507179a3d53fd?s=32&d=identicon&r=PG"
Call SaveOnServer(strImageUrl, "bill_avatar.jpg")
Sub SaveOnServer(url, strFileName)
Dim strRawData, objFSO, objFile
Dim strFilePath, strFolderPath, strError
strRawData = GetBinarySource(url, strError)
If Len(strError)>0 Then
Response.Write("<span style=""color: red;"">Failed to get binary source. Error:<br />" & strError & "</span>")
Else
strFolderPath = Server.MapPath(CONTENT_FOLDER_NAME)
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
If Not(objFSO.FolderExists(strFolderPath)) Then
objFSO.CreateFolder(strFolderPath)
End If
If Len(strFileName)=0 Then
strFileName = GetCleanName(url)
End If
strFilePath = Server.MapPath(CONTENT_FOLDER_NAME & "/" & strFileName)
Set objFile = objFSO.CreateTextFile(strFilePath)
objFile.Write(RSBinaryToString(strRawData))
objFile.Close
Set objFile = Nothing
Set objFSO = Nothing
Response.Write("<h3>Stored contents of " & url & ", total of <span style=""color: blue;"">" & LenB(strRawData) & "</span> bytes</h3>")
Response.Write("<a href=""" & CONTENT_FOLDER_NAME & "/" & strFileName & """ target=""_blank""><span style=""color: blue;"">" &_
strFileName & "</span></a>")
End If
End Sub
Function RSBinaryToString(xBinary)
''# Antonin Foller, http://www.motobit.com
''# RSBinaryToString converts binary data (VT_UI1 | VT_ARRAY Or MultiByte string)
''# to a string (BSTR) using ADO recordset
Dim Binary
'' #MultiByte data must be converted To VT_UI1 | VT_ARRAY first.
If vartype(xBinary)=8 Then Binary = MultiByteToBinary(xBinary) Else Binary = xBinary
Dim RS, LBinary
Const adLongVarChar = 201
Set RS = CreateObject("ADODB.Recordset")
LBinary = LenB(Binary)
If LBinary>0 Then
RS.Fields.Append "mBinary", adLongVarChar, LBinary
RS.Open
RS.AddNew
RS("mBinary").AppendChunk Binary
RS.Update
RSBinaryToString = RS("mBinary")
Else
RSBinaryToString = ""
End If
End Function
Function MultiByteToBinary(MultiByte)
''# © 2000 Antonin Foller, http://www.motobit.com
''# MultiByteToBinary converts multibyte string To real binary data (VT_UI1 | VT_ARRAY)
''# Using recordset
Dim RS, LMultiByte, Binary
Const adLongVarBinary = 205
Set RS = CreateObject("ADODB.Recordset")
LMultiByte = LenB(MultiByte)
If LMultiByte>0 Then
RS.Fields.Append "mBinary", adLongVarBinary, LMultiByte
RS.Open
RS.AddNew
RS("mBinary").AppendChunk MultiByte & ChrB(0)
RS.Update
Binary = RS("mBinary").GetChunk(LMultiByte)
End If
MultiByteToBinary = Binary
End Function
Function GetBinarySource(url, ByRef strError)
Dim objXML
Set objXML=Server.CreateObject("Microsoft.XMLHTTP")
GetBinarySource=""
strError = ""
On Error Resume Next
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
Err.Clear
Set objXML = Server.CreateObject("MSXML2.ServerXMLHTTP")
objXML.Open "GET", url, False
objXML.Send
If Err.Number<>0 Then
strError = "Error " & Err.Number & ": " & Err.Description
Err.Clear
Exit Function
End If
End If
On Error Goto 0
GetBinarySource=objXML.ResponseBody
Set objXML=Nothing
End Function
Function GetCleanName(s)
Dim result, x, c
Dim arrTemp
arrTemp = Split(s, "/")
If UBound(arrTemp)>0 Then
For x=0 To UBound(arrTemp)-1
result = result & GetCleanName(arrTemp(x)) & "_"
Next
result = result & GetPageName(s)
Else
For x=1 To Len(s)
c = Mid(s, x, 1)
If IsValidChar(c) Then
result = result & c
Else
result = result & "_"
End If
Next
End If
Erase arrTemp
GetCleanName = result
End Function
Function IsValidChar(c)
IsValidChar = (c >= "a" And c <= "z") Or (c >= "A" And c <= "Z") Or (IsNumeric(c))
End Function
Function GetPageName(strUrl)
If Len(strUrl)>0 Then
GetPageName=Mid(strUrl, InStrRev(strUrl, "/")+1, Len(strUrl))
Else
GetPageName=""
End If
End Function
%>
Just call SaveOnServer sub routine passing the URL and desired file name, you can also omit the file name and in that case, the file name will be taken from the URL itself.
The server folder is defined as constant and will be in the same place as .asp file.
Here is the gist of how to download and save files in script:-
Function DownloadAndSave(sourceUrl, destinationFile)
Dim req : Set req = CreateObject("WinHttp.WinHttpRequest.5.1")
req.Open "GET", sourceUrl, false
req.Send
Dim stream : Set stream = CreateObject("ADODB.Stream")
stream.Type = 1 ''# adTypeBinary
stream.Open
stream.Write req.ResponseBody
stream.SaveToFile destinationFile, 2
stream.Close
End Function