While running the following code :
Public Class Form4
'Public LAST_USER As String = "last user: uidxxxxx"
Friend WithEvents LastUser As System.Windows.Forms.TextBox
Private Sub checkFile()
If File.Exists("D:\Tebenator\userid.txt") = False Then
Try
File.Create("D:\Tebenator\userid.txt")
' Info()
Catch ex As Exception
MsgBox("Exception:" + ex.ToString)
End Try
Else
Info()
End If
End Sub
Private Sub Info()
Dim line As String
Dim objReader As New System.IO.StreamReader("D:\Tebenator\userid.txt")
Do While objReader.Peek() <> -1
line = objReader.ReadLine
If (String.IsNullOrEmpty(line.ToString)) Then
TextBox1.Text = " Last session info:" & Environment.NewLine +
"-Last user : uidxxxxx" & Environment.NewLine +
"-Session closed: (manual or automatically at xx:xx (local)"
Exit Do
Else
If (line.StartsWith("last_user")) Then
Dim a() As String
a = Split(line, "uid")
If (String.IsNullOrWhiteSpace(a.ToString)) Then
TextBox1.Text = " Last session info:" & Environment.NewLine +
"-Last user : uidxxxxx" & Environment.NewLine +
"-Session closed: (manual or automatically at xx:xx (local)"
Else
For i As Integer = 0 To a.Length - 1
Dim info As System.IO.FileInfo
info = My.Computer.FileSystem.GetFileInfo("D:\Tebenator\userid.txt")
TextBox1.Text = " Last session info:" & Environment.NewLine +
"-Last user :uid" + a(i) & Environment.NewLine +
"-Session closed: (manual or automatically on " + info.LastWriteTime + ")"
Next
End If
End If
End If
Loop
objReader.Close()
End Sub
Private Sub Form4_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
'checkFile()
Projects.Items.Add("A")
Projects.Items.Add("B")
Projects.Items.Add("C")
End Sub
Private Sub PictureBoxLogo_Click(sender As Object, e As EventArgs) Handles PictureBoxLogo.Click
Dim path As String
path = System.IO.Path.GetDirectoryName( _
System.Reflection.Assembly.GetExecutingAssembly().GetName().CodeBase)
'System.Diagnostics.Process.Start(path & "\kill tebenator.exe")
End Sub
Private Sub LinkLabelMapDrives_LinkClicked(ByVal sender As System.Object, ByVal e As System.Windows.Forms.LinkLabelLinkClickedEventArgs) Handles LinkLabelMapDrives.LinkClicked
Form2.Show()
End Sub
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Button1.FlatAppearance.BorderColor = Color.Orange
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Button2.FlatAppearance.BorderColor = Color.Orange
If MessageBox.Show("Confirm SHUT DOWN action?", "Tebenator Demon: Shutting down ..", MessageBoxButtons.YesNo) = Windows.Forms.DialogResult.Yes Then
Me.Close()
End If
End Sub
Private Sub Button3_Click(sender As Object, e As EventArgs) Handles Button3.Click
Button3.FlatAppearance.BorderColor = Color.Orange
Form3.Show()
End Sub
Private Sub ButtonStartSession_Click(sender As Object, e As EventArgs) Handles ButtonStartSession.Click
Dim Path1 As String
Path1 = "D:\users\Popa Andrei\project\Prj_A"
Dim Path2 As String
Path2 = "D:\users\Popa Andrei\project\Prj_B"
Dim Path3 As String
Path3 = "D:\users\Popa Andrei\project\Prj_C"
Dim id As Integer
id = Convert.ToInt32(TextBoxUid.Text)
If (id > 9999) Then
MessageBox.Show("Uid too long,please modify.", "Error!", MessageBoxButtons.OK)
ElseIf (id < 1000) Then
MessageBox.Show("Uid too short,pleaste modify.", "Error!", MessageBoxButtons.OK)
Else
Dim SelectedItem As Object
SelectedItem = Projects.SelectedItem
If (SelectedItem.ToString() Is "A") Then
Dim Folder As String = My.Computer.FileSystem.SpecialDirectories.Desktop + " \Dir_Project_" + SelectedItem.ToString
If Directory.Exists(Folder) = False Then
Try
Directory.CreateDirectory(Folder)
Catch ex As Exception
End Try
End If
For Each _File As String In Directory.GetFiles(Folder)
File.Delete(_File)
Next
My.Computer.FileSystem.CopyDirectory(Path1, Folder.ToString, True)
Process.Start(Folder)
End If
If (SelectedItem.ToString() Is "B") Then
Dim Folder As String = My.Computer.FileSystem.SpecialDirectories.Desktop + " \Dir_Project_" + SelectedItem.ToString
If Directory.Exists(Folder) = False Then
Try
Directory.CreateDirectory(Folder)
Catch ex As Exception
End Try
End If
For Each _File As String In Directory.GetFiles(Folder)
File.Delete(_File)
Next
My.Computer.FileSystem.CopyDirectory(Path2, Folder.ToString, True)
Process.Start(Folder)
End If
If (SelectedItem.ToString() Is "C") Then
Dim Folder As String = My.Computer.FileSystem.SpecialDirectories.Desktop + " \Dir_Project_" + SelectedItem.ToString
If Directory.Exists(Folder) = False Then
Try
Directory.CreateDirectory(Folder)
Catch ex As Exception
End Try
End If
For Each _File As String In Directory.GetFiles(Folder)
File.Delete(_File)
Next
My.Computer.FileSystem.CopyDirectory(Path3, Folder.ToString, True)
Process.Start(Folder)
End If
Dim File_Name As String = "D:\Tebenator\userid.txt"
Try
If File.Exists(File_Name) Then
Dim objWriter As New System.IO.StreamWriter(File_Name, True)
objWriter.Write("last_user=uid" + TextBoxUid.Text)
objWriter.Close()
End If
Catch ex As Exception
MsgBox("Exception:" + ex.ToString)
End Try
End If
End Sub
Public Sub New()
' This call is required by the designer.
InitializeComponent()
' Add any initialization after the InitializeComponent() call.
checkFile()
End Sub
End Class
The form loads correctly, i type in uid the value then select the project but when i click Start Session i get the following error at line 168 (Dim objWriter As New System.IO.StreamWriter(File_Name, True) ):
A first chance exception of type 'System.IO.IOException' occurred in mscorlib.dll
The correct way is to modify the checkFile method ,like this :
Private Sub checkFile()
If File.Exists("D:\Tebenator\userid.txt") = False Then
Try
Dim f As FileStream = File.Create("D:\Tebenator\userid.txt")
f.Close()
Catch ex As Exception
MsgBox("Exception:" + ex.ToString)
End Try
Else
End If
End Sub
Related
To facilitate special folder processing, I wrote some code to return requested values based on an Enum with values for DeskTop, Default, MyDocuments, etc. The enum value is then converted to the appropriate string and processed by the code. The code works and returns expected values for all values except Default and MyDocuments. The Default and MyDocuments return an empty string. As a work-around for those two situations, I get the Environment Variable "UserProfile" + "\Documents" which works.
All of the enum values have a corresponding Get method that returns the value (e.g. GetFontsFolder, GetDeskTopFolder, etc). They all call in to a common function GetSpecialFolder shown below. Here are a couple examples:
' GetFontsFolder
Public Function GetFontsFolder(Optional bDebugging As Boolean = False) As String
GetFontsFolder = GetSpecialFolder(SpecialFolders.Fonts, bDebugging)
End Function
' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function
Here is the code for MyDefaultFolder:
Private m_MyDefaultFolder As SpecialFolders
MyDefaultFolder = SpecialFolders.MyDocuments
Public Property Let MyDefaultFolder(eSpecialFolder As SpecialFolders)
m_MyDefaultFolder = eSpecialFolder
End Property
Public Property Get MyDefaultFolder() As SpecialFolders
MyDefaultFolder = m_MyDefaultFolder
End Property
Can someone explain why Default and MyDocuments return empty strings and everything else returns expected values? Is there a better way to get those values than using the UserProfile Environment Variable?
Here is the enum and function code:
Public Enum SpecialFolders
' Must always be the first value - 1
' Special case that will not show up in the list
[_First] = -1
None = 0
Default
AllUsersDesktop
AllUsersStartMenu
AllUsersPrograms
AllUsersStartup
Desktop
Favorites
Fonts
MyDocuments
NetHood
PrintHood
Programs
Recent
SendTo
StartMenu
Startup
Templates
' Must always be the next to the last value + 1
' Special case that will not show up in the list
[_Last] = Templates + 1
End Enum
Public Function GetSpecialFolder(Optional eSpecialFolder As SpecialFolders = SpecialFolders.Default, _
Optional bDebugging As Boolean = False) As String
Dim WshShell As Object
Dim lIndex As Long
Dim sPath As String
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
' Must be variants, not strings or the code will not work.
vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
vSpecialFolderName = vSpecialFolderNames(eSpecialFolder)
Set WshShell = CreateObject("WScript.Shell")
If eSpecialFolder = SpecialFolders.Default Then
vSpecialFolder = GetMyDefaultFolder
If vSpecialFolder = vbNullString Then
vSpecialFolder = Environ$("USERPROFILE") & "\Documents"
End If
Else
vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
If vSpecialFolder = vbNullString Then
If eSpecialFolder = SpecialFolders.MyDocuments Then
vSpecialFolder = Environ$("USERPROFILE") & "\Documents"
End If
End If
End If
''For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
'' vSpecialFolderName = vSpecialFolderNames(lIndex)
'' sPath = WshShell.SpecialFolders(vSpecialFolderName)
'' Debug.Print lIndex; vSpecialFolderName; " "; sPath; " "; IIf(sPath = vbNullString, "*****", vbNullString)
''Next
If bDebugging Then
Debug.Print CStr(eSpecialFolder); ", '"; vSpecialFolderName; "', '"; vSpecialFolder; "'"
End If
GetSpecialFolder = vSpecialFolder
Set WshShell = Nothing
End Function
' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function
If anyone is interested, here is the complete code for my cSpecialFolders class, part of which is referenced in my original question above. I expose enumeration values via ReadOnly Public Properties (e.g. DesktopFolder) as well as public Get methods (e.g. GetDeskTopFolder):
' Desktop
Public Property Get DesktopFolder() As String
DesktopFolder = GetSpecialFolder(SpecialFolders.Desktop)
End Property
' GetDesktopFolder
Public Function GetDesktopFolder(Optional bDebugging As Boolean = False) As String
GetDesktopFolder = GetSpecialFolder(SpecialFolders.Desktop, bDebugging)
End Function
All of the code:
Option Explicit
' Required References
' 1. Microsoft Scripting Runtime (scrrun.dll)
' Adapted
' From: WshShell.SpecialFolders
' Link: https://ss64.com/vb/special.html
' Also: An A-Z Index of Windows VBScript commands
' Link: https://ss64.com/vb/
' *************************
' ** **
' ** SpecialFolders Enum **
' ** **
' *************************
Public Enum SpecialFolders
' Must always be the first value - 1
' Special case that will not show up in the list
[_First] = -1
None = 0
Default
AllUsersDesktop
AllUsersStartMenu
AllUsersPrograms
AllUsersStartup
Desktop
Favorites
Fonts
MyDocuments
NetHood
PrintHood
Programs
Recent
SendTo
StartMenu
Startup
Templates
' Must always be the next to the last value + 1
' Special case that will not show up in the list
[_Last] = Templates + 1
End Enum
' ********************
' ** **
' ** Private Fields **
' ** **
' ********************
' Can be set in the constructor or via MyDefaultFolder property or SetMyDefaultFolder method.
Private m_MyDefaultFolder As SpecialFolders
Private Const m_DocumentsText As String = "\Documents"
Private Const m_UserProfileText As String = "USERPROFILE"
' Associated enumeration names. Excel does not provide these natively.
Private Const m_SpecialFolderNames As Variant = "None,Default,AllUsersDesktop,AllUsersStartMenu,AllUsersPrograms,AllUsersStartup,Desktop,Favorites,Fonts,MyDocuments,NetHood,PrintHood,Programs,Recent,SendTo,StartMenu,Startup,Templates"
' ********************************
' ** **
' ** Public ReadOnly Properties **
' ** **
' ********************************
Public Property Let MyDefaultFolder(eSpecialFolder As SpecialFolders)
m_MyDefaultFolder = eSpecialFolder
End Property
Public Property Get MyDefaultFolder() As SpecialFolders
MyDefaultFolder = m_MyDefaultFolder
End Property
' None
Public Property Get NoneFolder() As String
NoneFolder = GetSpecialFolder(SpecialFolders.None)
End Property
' Default
Public Property Get DefaultFolder() As String
DefaultFolder = GetSpecialFolder(SpecialFolders.Default)
End Property
' AllUsersDesktop
Public Property Get AllUsersDesktopFolder() As String
AllUsersDesktopFolder = GetSpecialFolder(SpecialFolders.AllUsersDesktop)
End Property
' AllUsersStartMenu
Public Property Get AllUsersStartMenuFolder() As String
AllUsersStartMenuFolder = GetSpecialFolder(SpecialFolders.AllUsersStartMenu)
End Property
' AllUsersPrograms
Public Property Get AllUsersProgramsFolder() As String
AllUsersProgramsFolder = GetSpecialFolder(SpecialFolders.AllUsersPrograms)
End Property
' AllUsersStartup
Public Property Get AllUsersStartupFolder() As String
AllUsersStartupFolder = GetSpecialFolder(SpecialFolders.AllUsersStartup)
End Property
' Desktop
Public Property Get DesktopFolder() As String
DesktopFolder = GetSpecialFolder(SpecialFolders.Desktop)
End Property
' Favorites
Public Property Get FavoritesFolder() As String
FavoritesFolder = GetSpecialFolder(SpecialFolders.Favorites)
End Property
' Fonts
Public Property Get FontsFolder() As String
FontsFolder = GetSpecialFolder(SpecialFolders.Fonts)
End Property
' MyDocuments
Public Property Get MyDocumentsFolder() As String
MyDocumentsFolder = GetSpecialFolder(SpecialFolders.MyDocuments)
End Property
' NetHood
Public Property Get NetHoodFolder() As String
NetHoodFolder = GetSpecialFolder(SpecialFolders.NetHood)
End Property
' PrintHood
Public Property Get PrintHoodFolder() As String
PrintHoodFolder = GetSpecialFolder(SpecialFolders.PrintHood)
End Property
' Programs
Public Property Get ProgramsFolder() As String
ProgramsFolder = GetSpecialFolder(SpecialFolders.Programs)
End Property
' Recent
Public Property Get RecentFolder() As String
RecentFolder = GetSpecialFolder(SpecialFolders.Recent)
End Property
' SendTo
Public Property Get SendToFolder() As String
SendToFolder = GetSpecialFolder(SpecialFolders.SendTo)
End Property
' StartMenu
Public Property Get StartMenuFolder() As String
StartMenuFolder = GetSpecialFolder(SpecialFolders.StartMenu)
End Property
' Startup
Public Property Get StartupFolder() As String
StartupFolder = GetSpecialFolder(SpecialFolders.Startup)
End Property
' Templates
Public Property Get TemplatesFolder() As String
TemplatesFolder = GetSpecialFolder(SpecialFolders.Templates)
End Property
' ******************************
' ** **
' ** Constructor & Destructor **
' ** **
' ******************************
Private Sub Class_Initialize()
' Setup the default folder.
Me.MyDefaultFolder = SpecialFolders.MyDocuments
End Sub
' ************************
' ** **
' ** Public Get Methods **
' ** **
' ************************
Public Function GetSpecialFolder(Optional eSpecialFolder As SpecialFolders = SpecialFolders.Default, Optional bDebugging As Boolean = False) As String
Dim WshShell As Object
Dim lIndex As Long
Dim sPath As String
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
' Must be variants, not strings or the code will not work.
vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
vSpecialFolderName = vSpecialFolderNames(eSpecialFolder)
Set WshShell = CreateObject("WScript.Shell")
If eSpecialFolder = SpecialFolders.Default Then
vSpecialFolder = GetMyDefaultFolder
If vSpecialFolder = vbNullString Then
vSpecialFolder = Environ$(m_UserProfileText) & m_DocumentsText
End If
Else
vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
If vSpecialFolder = vbNullString Then
If eSpecialFolder = SpecialFolders.MyDocuments Then
vSpecialFolder = Environ$(m_UserProfileText) & m_DocumentsText
End If
End If
End If
''For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
'' vSpecialFolderName = vSpecialFolderNames(lIndex)
'' sPath = WshShell.SpecialFolders(vSpecialFolderName)
'' Debug.Print lIndex; vSpecialFolderName; " "; sPath; " "; IIf(sPath = vbNullString, "*****", vbNullString)
''Next
If bDebugging Then
Debug.Print CStr(eSpecialFolder); ", '"; vSpecialFolderName; "', '"; vSpecialFolder; "'"
End If
GetSpecialFolder = vSpecialFolder
Set WshShell = Nothing
End Function
' GetMyDefaultFolder
Public Function GetMyDefaultFolder(Optional bDebugging As Boolean = False) As String
GetMyDefaultFolder = GetSpecialFolder(MyDefaultFolder, bDebugging)
End Function
' SetMyDefaultFolder
Public Sub SetMyDefaultFolder(eSpecialFolder As SpecialFolders)
MyDefaultFolder = eSpecialFolder
End Sub
' GetAllUsersDesktopFolder
Public Function GetAllUsersDesktopFolder(Optional bDebugging As Boolean = False) As String
GetAllUsersDesktopFolder = GetSpecialFolder(SpecialFolders.AllUsersDesktop, bDebugging)
End Function
' GetAllUsersStartMenuFolder
Public Function GetAllUsersStartMenuFolder(Optional bDebugging As Boolean = False) As String
GetAllUsersStartMenuFolder = GetSpecialFolder(SpecialFolders.AllUsersStartMenu, bDebugging)
End Function
' GetAllUsersProgramsFolder
Public Function GetAllUsersProgramsFolder(Optional bDebugging As Boolean = False) As String
GetAllUsersProgramsFolder = GetSpecialFolder(SpecialFolders.AllUsersPrograms, bDebugging)
End Function
' GetAllUsersStartupFolder
Public Function GetAllUsersStartupFolder(Optional bDebugging As Boolean = False) As String
GetAllUsersStartupFolder = GetSpecialFolder(SpecialFolders.AllUsersStartup, bDebugging)
End Function
' GetDesktopFolder
Public Function GetDesktopFolder(Optional bDebugging As Boolean = False) As String
GetDesktopFolder = GetSpecialFolder(SpecialFolders.Desktop, bDebugging)
End Function
' GetFavoritesFolder
Public Function GetFavoritesFolder(Optional bDebugging As Boolean = False) As String
GetFavoritesFolder = GetSpecialFolder(SpecialFolders.Favorites, bDebugging)
End Function
' GetFontsFolder
Public Function GetFontsFolder(Optional bDebugging As Boolean = False) As String
GetFontsFolder = GetSpecialFolder(SpecialFolders.Fonts, bDebugging)
End Function
' GetMyDocumentsFolder
Public Function GetMyDocumentsFolder(Optional bDebugging As Boolean = False) As String
GetMyDocumentsFolder = GetSpecialFolder(SpecialFolders.MyDocuments, bDebugging)
End Function
' GetNetHoodFolder
Public Function GetNetHoodFolder(Optional bDebugging As Boolean = False) As String
GetNetHoodFolder = GetSpecialFolder(SpecialFolders.NetHood, bDebugging)
End Function
' GetPrintHoodFolder
Public Function GetPrintHoodFolder(Optional bDebugging As Boolean = False) As String
GetPrintHoodFolder = GetSpecialFolder(SpecialFolders.PrintHood, bDebugging)
End Function
' GetProgramsFolder
Public Function GetProgramsFolder(Optional bDebugging As Boolean = False) As String
GetProgramsFolder = GetSpecialFolder(SpecialFolders.Programs, bDebugging)
End Function
' GetRecentFolder
Public Function GetRecentFolder(Optional bDebugging As Boolean = False) As String
GetRecentFolder = GetSpecialFolder(SpecialFolders.Recent, bDebugging)
End Function
' GetSendToFolder
Public Function GetSendToFolder(Optional bDebugging As Boolean = False) As String
GetSendToFolder = GetSpecialFolder(SpecialFolders.SendTo, bDebugging)
End Function
' GetStartMenuFolder
Public Function GetStartMenuFolder(Optional bDebugging As Boolean = False) As String
GetStartMenuFolder = GetSpecialFolder(SpecialFolders.StartMenu, bDebugging)
End Function
' GetStartupFolder
Public Function GetStartupFolder(Optional bDebugging As Boolean = False) As String
GetStartupFolder = GetSpecialFolder(SpecialFolders.Startup, bDebugging)
End Function
' GetTemplatesFolder
Public Function GetTemplatesFolder(Optional bDebugging As Boolean = False) As String
GetTemplatesFolder = GetSpecialFolder(SpecialFolders.Templates, bDebugging)
End Function
' **************************
' ** **
' ** Other Public Methods **
' ** **
' **************************
Public Function GetSpecialFoldersListDict() As Dictionary
Dim WshShell As Object
Dim oDict As Dictionary
Dim lIndex As Long
Dim vSpecialFolderNames As Variant, vSpecialFolderName As Variant, vSpecialFolder As Variant
Set WshShell = CreateObject("WScript.Shell")
' Key = SpecialFolders enum value, Value = Associated path
Set oDict = New Dictionary
' Must be variants, not strings or the code will not work.
vSpecialFolderNames = Split(m_SpecialFolderNames, ",")
For lIndex = SpecialFolders.[_First] + 1 To SpecialFolders.[_Last] - 1
vSpecialFolderName = vSpecialFolderNames(lIndex)
If lIndex = SpecialFolders.Default Then
vSpecialFolder = GetMyDefaultFolder
Else
vSpecialFolder = WshShell.SpecialFolders(vSpecialFolderName)
End If
''Debug.Print lIndex, vSpecialFolderName, vSpecialFolder
Call oDict.Add(lIndex, vSpecialFolder)
Next
Set GetSpecialFoldersListDict = oDict
Set WshShell = Nothing
End Function
' *************************
' ** **
' ** Simple Test Methods **
' ** **
' *************************
Public Sub ListAllSpecialFolders()
Debug.Print TypeName(SpecialFolders.MyDocuments)
Debug.Print GetSpecialFolder(SpecialFolders.None, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Default, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.AllUsersDesktop, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.AllUsersStartMenu, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.AllUsersPrograms, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.AllUsersStartup, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Desktop, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Favorites, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Fonts, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.MyDocuments, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.NetHood, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.PrintHood, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Programs, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Recent, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.SendTo, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.StartMenu, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Startup, bDebugging:=True)
Debug.Print GetSpecialFolder(SpecialFolders.Templates, bDebugging:=True)
End Sub
Private Sub TestGet()
Debug.Print GetSpecialFolder(bDebugging:=True)
End Sub
' *******************
' ** **
' ** Sample Values **
' ** **
' *******************
' 0, 'None', ''
' 1, 'Default', ''
' 2, 'AllUsersDesktop', 'C:\Users\Public\Desktop
' 3, 'AllUsersStartMenu', 'C:\ProgramData\Microsoft\Windows\Start Menu'
' 4, 'AllUsersPrograms', 'C:\ProgramData\Microsoft\Windows\Start Menu\Programs'
' 6, 'Desktop', 'C:\Users\MyUserName\Desktop'
' 7, 'Favorites', 'C:\Users\MyUserName\Favorites'
' 8, 'Fonts', 'C:\Windows\Fonts'
' 9, 'MyDocuments', 'C:\Users\MyUserName\Documents'
' 10, 'NetHood', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Network Shortcuts'
' 11, 'PrintHood', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Printer Shortcuts'
' 12, 'Programs', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu\Programs'
' 13, 'Recent', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Recent'
' 14, 'SendTo', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\SendTo'
' 15, 'StartMenu', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu'
' 16, 'Startup', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup'
' 17, 'Templates', 'C:\Users\MyUserName\AppData\Roaming\Microsoft\Windows\Templates'
I use the following code that I copied from (https://datapluscode.com/general/add-an-audit-trail-to-an-excel-spreadsheet-using-vba) to record a logfile of changes in excel files that are used to collect data for clinical research.
This worked brilliantly until earlier this year when something (perhaps an update to Excel) has bricked it. It no longer records anything, although the code seems to run without obvious error.
There are two facets to the code.
Firstly, a class module called csLogger
Option Explicit
Option Compare Text
Private Type udtLogEntry
Date As String * 22
NewCellValue As String * 30
OldCellValue As String * 30
CellRef As String * 15
UserName As String * 10
SheetName As String * 20
NewFormula As String * 40
OldFormula As String * 40
ChangeType As String * 12
End Type
Private mudtEntry As udtLogEntry
Private Const CSTR_CELL_ADJUSTMENT_TYPE As String = "Cell"
Private Const CSTR_LOG_FILENAME_SUFFIX As String = "_log.txt"
Public Sub LogSheetChangeEvent(ByVal Sh As Object, ByVal Target As Range)
On Error GoTo ERR_HANDLER:
Dim strText As String
If Not ThisWorkbook.ReadOnly Then
If (Target.Rows.Count = 1) And (Target.Columns.Count = 1) Then
mudtEntry.SheetName = CStr(Sh.Name)
mudtEntry.CellRef = CStr(Target.Address)
mudtEntry.ChangeType = CSTR_CELL_ADJUSTMENT_TYPE
mudtEntry.Date = CStr(Now())
mudtEntry.NewCellValue = CStr(Target.Value)
mudtEntry.UserName = Environ("username")
mudtEntry.NewFormula = CStr(Target.Formula)
strText = BuildLogString(mudtEntry.Date, mudtEntry.NewCellValue, _
mudtEntry.OldCellValue, mudtEntry.CellRef, _
mudtEntry.UserName, mudtEntry.SheetName, mudtEntry.OldFormula, _
mudtEntry.NewFormula, mudtEntry.ChangeType)
Call fnAddToFile(strText)
End If
End If
EXIT_HERE:
Exit Sub
ERR_HANDLER:
GoTo EXIT_HERE
End Sub
Public Sub LogSheetSelectionChangeEvent(ByVal Sh As Object, ByVal Target As Range)
On Error Resume Next
If Not ThisWorkbook.ReadOnly Then
If (Target.Rows.Count = 1) And (Target.Columns.Count = 1) Then
mudtEntry.OldCellValue = CStr(Target.Value)
mudtEntry.OldFormula = CStr(Target.Formula)
End If
End If
End Sub
Public Sub LogEventAction(ByVal strEvent As String)
Dim udtEntry As udtLogEntry
udtEntry.Date = Now()
udtEntry.ChangeType = strEvent
udtEntry.UserName = Environ("username")
If Not fnAddToFile(udtEntry.Date & "," & udtEntry.UserName & "," & udtEntry.ChangeType) Then
Debug.Print "Failed to log event"
End If
End Sub
Private Function fnAddToFile(ByVal strText As String) As Boolean
On Error GoTo ERR_HANDLER:
Dim intHandle As Integer
Dim strFileName As String
fnAddToFile = False
If ThisWorkbook.ReadOnly Then
fnAddToFile = False
GoTo EXIT_HERE
End If
intHandle = FreeFile
strFileName = Mid(ThisWorkbook.Name, 1, InStr(1, ThisWorkbook.Name, ".") - 1)
strFileName = strFileName & CSTR_LOG_FILENAME_SUFFIX
strFileName = ThisWorkbook.Path & Chr(92) & strFileName
If Not IsLogFilePresent(strFileName) Then
Open strFileName For Append As #intHandle
Dim udtHeader As udtLogEntry
Dim strTitles As String
udtHeader.SheetName = "Sheet Name"
udtHeader.Date = "Date & Time"
udtHeader.CellRef = "Cell Ref"
udtHeader.SheetName = "Sheetname"
udtHeader.UserName = "UserName"
udtHeader.NewCellValue = "New Value"
udtHeader.OldCellValue = "Old Value"
udtHeader.NewFormula = "New Value Formula"
udtHeader.OldFormula = "Old Value Formula"
udtHeader.ChangeType = "Type"
strTitles = BuildLogString(udtHeader.Date, udtHeader.NewCellValue, _
udtHeader.OldCellValue, udtHeader.CellRef, _
udtHeader.UserName, udtHeader.SheetName, _
udtHeader.OldFormula, udtHeader.NewFormula, _
udtHeader.ChangeType)
Print #intHandle, strTitles
Print #intHandle, strText
Close #intHandle
Else
Open strFileName For Append As #intHandle
Print #intHandle, strText
Close #intHandle
End If
fnAddToFile = True
EXIT_HERE:
Exit Function
ERR_HANDLER:
fnAddToFile = False
GoTo EXIT_HERE
End Function
Private Function BuildLogString(ByVal strDate As String, ByVal strNew As String, ByVal strOld As String, _
ByVal strRef As String, ByVal strName As String, ByVal strSheet As String, _
ByVal strOldFormula As String, ByVal strNewFormula As String, ByVal strChangeType As String) As String
Dim strText As String
On Error Resume Next
strSheet = UCase(strSheet)
BuildLogString = _
strDate & "," & strName & "," & strChangeType & "," & strSheet & "," & strRef & ", " & strNew & "," & strOld & _
"," & strNewFormula & "," & strOldFormula
End Function
Private Function IsLogFilePresent(ByVal strFile As String) As Boolean
On Error GoTo ERR_HANDLER:
IsLogFilePresent = False
If Trim(Dir(strFile)) <> "" Then
IsLogFilePresent = True
Else
IsLogFilePresent = False
End If
EXIT_HERE:
Exit Function
ERR_HANDLER:
IsLogFilePresent = False
GoTo EXIT_HERE
End Function
Then, code in ThisWorkbook, as follows
Option Explicit
Private mObjLogger As csLogger
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not mObjLogger Is Nothing Then
mObjLogger.LogEventAction ("CLOSE")
Set mObjLogger = Nothing
End If
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
If Not mObjLogger Is Nothing Then
mObjLogger.LogEventAction ("SAVE")
End If
End Sub
Private Sub Workbook_Open()
Set mObjLogger = New csLogger
mObjLogger.LogEventAction ("OPEN")
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not mObjLogger Is Nothing Then
mObjLogger.LogSheetChangeEvent Sh, Target
End If
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not mObjLogger Is Nothing Then
mObjLogger.LogSheetSelectionChangeEvent Sh, Target
End If
End Sub
If anyone has any ideas as to why it is no longer working I would be really grateful! I cannot work it out. I tried to ask on the original page but my comments are rejected by the server. The author also no longer seems to be active. Thank you.
I am trying to read an excel file with strict format and then write the content into a SPF file.
Here is my code:
Imports System.IO.Path
Imports System.Data
Public Class Form1
Private Sub Button1_Click(sender As Object, e As EventArgs) Handles Button1.Click
Dim fileName As String
Dim folderName As String
fileName = ""
folderName = ""
Call getFileAndFolderName(fileName, folderName)
End Sub
Private Sub getFileAndFolderName(ByRef fileName As String, ByRef folderName As String)
OpenFileDialog1.FileName = ""
OpenFileDialog1.Filter = "Excel files(*.xls;*.xlsx)|*xls;*xlsx"
OpenFileDialog1.ShowDialog()
fileName = OpenFileDialog1.FileName
Try
folderName = GetDirectoryName(fileName)
Catch ex As Exception
MsgBox(ex.ToString)
End Try
If folderName = "" Or fileName = "" Then
MsgBox("No File or folder is selected")
Exit Sub
End If
End Sub
Private Sub Button2_Click(sender As Object, e As EventArgs) Handles Button2.Click
Dim fileName As String
Dim folderName As String
fileName = ""
folderName = ""
Call getFileAndFolderName(fileName, folderName)
Try
Dim MyConnection As OleDb.OleDbConnection
Dim DtSet As DataSet
Dim DtTable As DataTable
Dim MyCommand As OleDb.OleDbDataAdapter
MyConnection = New OleDb.OleDbConnection("provider=Microsoft.Jet.OLEDB.4.0;" & "Data Source=" & fileName & "; " & "Extended Properties=Excel 8.0;")
MyCommand = New OleDb.OleDbDataAdapter("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "TestTable")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
DataGridView1.DataSource = DtSet.Tables(0)
DtTable = DtSet.Tables(0)
Dim S() As Object
s = DtTable.Rows(0).ItemArray
MsgBox(s(3).ToString)
MyConnection.Close()
Catch ex As Exception
MsgBox(ex.ToString)
End Try
End Sub
End Class
It works at the first few steps, all the content is written on the DataGridView1, and then I want to retrieve the first row to get each cell of it, I don't know how to continue.
The format of the excel file is
Index property1 property2...
1 xx xx
2 xx xx
3 xx xx
Can anyone help me out? Thank you in advance!
i have problem with load Ms excel file into DataGridview, the problem is if the data in each cell content the symbol "+", "-", "*", "/", "!", "#", "#", "$", "%", "&", ":", ";", "'", ",", ".", "?" . and i want to replace those symbol from my excel file when i upload it into DataGridview , how can i replace it , do anyone can help me ?
Imports System.IO
Public Class Form1
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
OpenFileDialog1.Filter = "Excel Worksheets|*.xls|All File (*.*)|*.*"
OpenFileDialog1.FilterIndex = 2
OpenFileDialog1.RestoreDirectory = True
If OpenFileDialog1.ShowDialog() = System.Windows.Forms.DialogResult.OK Then
TextBox1.Text = OpenFileDialog1.FileName
Button2.Visible = True
Button3.Visible = True
Try
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DataSet As System.Data.DataSet
Dim MyCommend As System.Data.OleDb.OleDbDataAdapter
Dim Path As String = OpenFileDialog1.FileName
MyConnection = New System.Data.OleDb.OleDbConnection("Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" + Path + ";Extended Properties=Excel 12.0;")
MyConnection.Open()
MyCommend = New System.Data.OleDb.OleDbDataAdapter("Select * from [Sheet1$]", MyConnection)
DataSet = New System.Data.DataSet
MyCommend.Fill(DataSet)
DataGridView1.DataSource = DataSet.Tables(0)
'DataGridView2.DataSource = DataGridView1.DataSource ' Copy from DataGredView 1 to 2
MyConnection.Close()
DataGridView1.Show()
Label4.Text = "It has " & DataGridView1.Rows.Count - 1 & " Element in list."
Catch ex As Exception
MsgBox(ex.Message.ToString)
End Try
End If
End Sub
Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click
Dim D50 As Integer = 0, D20 As Integer = 0, D10 As Integer = 0, D5 As Integer = 0, Total As Integer = 0
Dim Cards() As Integer = {50, 20, 10, 5}
Dim Phone As Integer = 0, Money As Integer = 0
Dim R As Integer = 0
Dim X As Integer = 0
Dim I As Integer
Dim Z As Integer = 0
Dim Result As String = ""
Dim TotalMoney As String = 0
Dim StrRepPhone As String = ""
Dim StrRepMoney As String = ""
Dim StrRep() As String = {"+", "-", "*", "/", "!", "#", "#", "$", "%", "&", ":", ";", "'", ",", ".", "?"}
For A As Integer = 0 To DataGridView1.Rows.Count - 1
StrRepPhone = DataGridView1.Rows(A).Cells(0).Value
StrRepMoney = CInt(DataGridView1.Rows(A).Cells(1).Value)
For B As Integer = 0 To 15
Phone = StrRepPhone.Replace(StrRep(B), "")
Money = StrRepMoney.Replace(StrRep(B), "")
Next
'Phone = DataGridView1.Rows(A).Cells(0).Value
'Money = CInt(DataGridView1.Rows(A).Cells(1).Value)
'' Find the Total Money while Cells index 1
TotalMoney += DataGridView1.Rows(A).Cells(1).Value
'/ Using X = Money Mod 5 to find all number could return 0, like 10 Mod 5= 0
X = Money Mod 5
I = 0
If X = 0 Then
While Money > 0
R = CInt(Money \ Cards(I))
Money = Money Mod Cards(I)
For Z = 1 To R
If R <> 0 Then
Result = Result & Phone & " " & Cards(I) & vbCrLf
' //Count the total number of each Card by using Card(I)
If Cards(I) = 50 Then
D50 += 1
ElseIf Cards(I) = 20 Then
D20 += 1
ElseIf Cards(I) = 10 Then
D10 += 1
Else
D5 += 1
End If
End If
Next
I += 1
End While
Label3.Text = "No remaining " & X
Else
'Label3.Text = "Remaining " & X ' remaing value after mod
'Label3.Text = "តម្លៃដែលមិនត្រូវគឺ" & Money & "ស្ថិតនៅជួរដេកទី " & DataGridView1.Rows(A).Index & " Remaining " & X
Label3.Text = "មានតម្លៃដែលបញ្ជូលមិនត្រឹមត្រូវ សូមធ្វើការពិនិត្យឡើងវិញ!"
Exit Sub
End If
Next
' Set the Multiline property to true.
TextBox2.Multiline = True
'TextBox2.Enabled = False
TextBox2.ScrollBars = ScrollBars.Vertical ' Add vertical scroll bars to the TextBox control.
TextBox2.AcceptsReturn = False ' Allow the TAB key to be entered in the TextBox control.
TextBox2.AcceptsTab = False ' Allow the TAB key to be entered in the TextBox control.
TextBox2.WordWrap = False ' Set WordWrap to true to allow text to wrap to the next line.
TextBox2.Text = Result
Label5.Text = "$50= " & D50
Label6.Text = "$20= " & D20
Label7.Text = "$10= " & D10
Label8.Text = "$05= " & D5
Label9.Text = "Total Money:$" & TotalMoney
end sub
From Excel to DataGridView.
Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click
Dim MyConnection As System.Data.OleDb.OleDbConnection
Dim DtSet As System.Data.DataSet
Dim MyCommand As System.Data.OleDb.OleDbDataAdapter
MyConnection = New System.Data.OleDb.OleDbConnection("provider=Microsoft.Jet.OLEDB.4.0;Data Source='C:\Users\Excel\Desktop\Book1.xls';Extended Properties=Excel 8.0;")
MyCommand = New System.Data.OleDb.OleDbDataAdapter("select * from [Sheet1$]", MyConnection)
MyCommand.TableMappings.Add("Table", "Net-informations.com")
DtSet = New System.Data.DataSet
MyCommand.Fill(DtSet)
DataGridView1.DataSource = DtSet.Tables(0)
MyConnection.Close()
End Sub
Also, export from DGV to Excel.
Imports System.Data.SqlClient
Imports Microsoft.Office.Interop.Excel
Imports Microsoft.Office.Interop
Public Class Form1
Private Sub Button2_Click(sender As System.Object, e As System.EventArgs) Handles Button2.Click
Dim xlApp As Microsoft.Office.Interop.Excel.Application
Dim xlWorkBook As Microsoft.Office.Interop.Excel.Workbook
Dim xlWorkSheet As Microsoft.Office.Interop.Excel.Worksheet
Dim misValue As Object = System.Reflection.Missing.Value
Dim i As Integer
Dim j As Integer
'xlApp = New Microsoft.Office.Interop.Excel.Global
'xlApp = New Microsoft.Office.Interop.Excel.ApplicationClass()
xlApp = New Excel.Application()
xlWorkBook = xlApp.Workbooks.Add(misValue)
xlWorkSheet = xlWorkBook.Sheets("sheet1")
For i = 0 To DataGridView1.RowCount - 2
For j = 0 To DataGridView1.ColumnCount - 1
For k As Integer = 1 To DataGridView1.Columns.Count
xlWorkSheet.Cells(1, k) = DataGridView1.Columns(k - 1).HeaderText
xlWorkSheet.Cells(i + 2, j + 1) = DataGridView1(j, i).Value.ToString()
Next
Next
Next
xlWorkSheet.SaveAs("C:\Users\Excel\Desktop\Book2.xls")
xlWorkBook.Close()
xlApp.Quit()
releaseObject(xlApp)
releaseObject(xlWorkBook)
releaseObject(xlWorkSheet)
MsgBox("C:\Users\Excel\Desktop\Book2.xls")
End Sub
Private Sub releaseObject(ByVal obj As Object)
Try
System.Runtime.InteropServices.Marshal.ReleaseComObject(obj)
obj = Nothing
Catch ex As Exception
obj = Nothing
Finally
GC.Collect()
End Try
End Sub
End Class
Hi all I'm using Open XML and ExtremML to generate an Excel File on the Server and Download it, but when you I try to open it it gives me the error "EXCEL FOUND UNREADABLE CONTENT. DO YOU WANT TO RECOVER THE CONTENTS OF THIS WORKBOOK?
IF YOU TRUST THE SOURCE OF THIS WORKBOOK, CLICK YES", so checking on the file inside y found it's adding a tag named company, that when i remove it it corrects the error that Excel is giving, It's in VB .NET, this is my code:
Protected Sub btnExcel_Click(ByVal sender As Object, ByVal e As System.EventArgs) Handles btnExcel.Click
Dim iProcess As String = ""
Dim loOraClientDb As clsOraClientDb = New clsOraClientDb
Dim vFilename As String = ""
Try
Try
iProcess = "btnExcel_Click 1"
Dim ExcelSendInfo As DataTable = Session("dtExcel")
Dim ExcelExportedInfo As DataTable = New DataTable
Dim PkgOutValues() As String = {}
Dim ExcelDataSet As DataSet = New DataSet
Dim vtablename As String = ""
Dim vtabletoname As String = ""
Dim WFT As New WebFileTools
If chkFLayout.Checked Then
iProcess = "btnExcel_Click 2"
Dim sDNS As StringBuilder = New StringBuilder()
If Not chkFInfo.Checked Then
For Each dr In ExcelSendInfo.Rows
sDNS.AppendLine(dr(0))
Next
End If
iProcess = "btnExcel_Click 3"
If Not loOraClientDb.Open(ConnectionStrings("DatabaseSDSTP6301").ConnectionString) Then
EnableErrorByState(loOraClientDb.Message & ", Process: " & iProcess)
Exit Sub
Else
iProcess = "btnExcel_Click 4"
Dim vStatus As String
If ViewState("CurrentWindow") = "Report" Then
vStatus = "G.G_STATUSID!=2"
Else
vStatus = "G.G_STATUSID=2"
End If
iProcess = "btnExcel_Click 5"
Dim PkgInParameters(6)() As String
PkgInParameters(0) = New String() {"VEXPORTEDDNS", "VARCHAR2", "Empty", sDNS.ToString.Replace(Chr(13) & Chr(10), ",")}
PkgInParameters(1) = New String() {"VSTATUS", "VARCHAR2", "Empty", vStatus}
PkgInParameters(2) = New String() {"chkFInfo", "VARCHAR2", "Empty", BoolToStr(chkFInfo.Checked)}
PkgInParameters(3) = New String() {"VSEARCHOPS", "VARCHAR2", "Empty", DDLSearchOps.SelectedValue}
PkgInParameters(4) = New String() {"VSEARCH", "VARCHAR2", "Empty", txtsearch.Text}
PkgInParameters(5) = New String() {"VRANGE1", "VARCHAR2", "Empty", txtrange1.Text}
PkgInParameters(6) = New String() {"VRANGE2", "VARCHAR2", "Empty", txtrange2.Text}
Dim PkgReturnParameters() As String
PkgReturnParameters = New String() {"VRETURN", "CURSOR", "Empty"}
Dim PkgOutParameters(0)() As String
PkgOutParameters(0) = New String() {"VTOTPROJS", "NUMBER", "Empty"}
iProcess = "btnExcel_Click 6"
If Not loOraClientDb.ExecuteProcedureFunction("PKG_GENERALINFO.GENERATEEXCEL", PkgInParameters, _
PkgOutParameters, PkgReturnParameters, , ExcelExportedInfo, _
, PkgOutValues) Then
EnableErrorByState(loOraClientDb.Message & ", Process: " & iProcess)
Exit Sub
End If
vtablename = "MAININFO"
vtabletoname = "MAINTABLE"
End If
Else
iProcess = "btnExcel_Click 7"
ExcelExportedInfo = ExcelSendInfo
vtablename = "TIMEREP"
vtabletoname = "TIMEREPORT"
End If
ExcelDataSet.Tables.Add(ExcelExportedInfo)
ExcelDataSet.Tables(0).TableName = vtablename
Dim vFileTemplate As String = ""
Dim RandomNumber As New Random()
If vtablename = "MAININFO" Then
vFileTemplate = "FullLayout.xlsx"
vFilename = "FullLayout" & RandomNumber.Next(1000).ToString & ".xlsx"
Else
vFileTemplate = "TimeReport.xlsx"
vFilename = "TimeReport" & RandomNumber.Next(1000).ToString & ".xlsx"
End If
Session("vfilename") = vFilename
WFT.CopyServerFile("ExcelTemplates\" & vFileTemplate, "ExcelTemplates\" & vFilename, True)
Using DPSExcelTemplate = ExcelOpenPackage(Server.MapPath(".") & "\ExcelTemplates", vFilename.Replace(".xlsx", ""))
ExcelWorkBookPopulateDS2Table(DPSExcelTemplate, ExcelDataSet, vtablename, vtabletoname)
End Using
Server.ClearError()
Response.Redirect("DownloadPage.aspx", False)
iProcess = "btnExcel_Click 28"
Catch ex As Exception
EnableErrorByState(ex.Message & ", Process: " & iProcess)
If File.Exists(Server.MapPath(".") & "\ExcelTemplates\" & vFilename) = True Then
File.Delete(Server.MapPath(".") & "\ExcelTemplates\" & vFilename)
End If
End Try
Finally
loOraClientDb.Close()
ShowCorrespondingWindows()
End Try
End Sub
The page DownloadPage.aspx has this code:
Imports WebFileTools
Imports System.IO
Partial Class DownloadPage
Inherits System.Web.UI.Page
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim vfilename = Session("vfilename").ToString
Dim nfilename = ""
If vfilename.IndexOf("FullLayout") <> -1 Then
nfilename = "FullLayout_" & Today.ToShortDateString
Else
nfilename = "TimeReport_" & Today.ToShortDateString
End If
Dim WFT As New WebFileTools
WFT.DownloadServerFile("ExcelTemplates\" & vfilename, MIMEType.Excel2007, nfilename)
End Sub
End Class
I can't seem to find the problem has anyone gotten this error or knows how to fix this problem?
I Forgot to add this code thats for generating the Excel file with ExtremMl:
Public Shared Function ExcelOpenPackage(ByVal ServerPath As String, _
ByVal ExcelFileName As String) As ExtremeML.Packaging.SpreadsheetDocumentWrapper
Dim ExcelPackage = SpreadsheetDocumentWrapper.Open(ServerPath & "\" & ExcelFileName & ".xlsx")
Return ExcelPackage
End Function
And this is to fill the info on the file:
Public Shared Sub ExcelWorkBookPopulateDS2Table(ByRef ExcelPackage As ExtremeML.Packaging.SpreadsheetDocumentWrapper, _
ByRef Data As DataSet, _
ByVal DataTableName As String, _
ByVal ExcelTableName As String)
Dim ExcelTable = ExcelPackage.WorkbookPart.GetTablePart(ExcelTableName).Table
ExcelTable.Fill(Data, DataTableName)
End Sub
I don't know exactly why but the problem was with my Download code previusly it was like this:
Public Sub DownloadServerFile(ByVal FileToDownload As String, ByVal MIMETYPE As MIMEType, Optional ByVal NewNameOfFileToDownload As String = "")
Dim FileExt As String = ""
Dim F2DArr As String = Path.GetFileName(FileToDownload)
Current.Response.ClearContent()
Current.Response.ClearHeaders()
Select Case MIMETYPE
Case WebFileTools.MIMEType.Excel2007
Current.Response.ContentType = _
"application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
FileExt = ".xlsx"
Case WebFileTools.MIMEType.Word2007
Current.Response.ContentType = _
"application/vnd.openxmlformats-officedocument.wordprocessingml.document"
FileExt = ".docx"
Case WebFileTools.MIMEType.PowerPoint2007
Current.Response.ContentType = _
"application/vnd.openxmlformats-officedocument.presentationml.presentation"
FileExt = ".pptx"
End Select
If NewNameOfFileToDownload.Trim.Length > 0 Then
Current.Response.AppendHeader("content-disposition", "inline;attachment;filename=" _
& NewNameOfFileToDownload & FileExt)
Else
Current.Response.AppendHeader("content-disposition", "inline;attachment;filename=" & F2DArr)
End If
Current.Response.Clear()
Current.Response.TransmitFile(Server.MapPath(".") & "\" & FileToDownload)
Current.Response.Flush()
If File.Exists(Server.MapPath(".") & "\" & FileToDownload) = True Then
File.Delete(Server.MapPath(".") & "\" & FileToDownload)
End If
Current.ApplicationInstance.CompleteRequest()
End Sub
Now i changed this line Current.ApplicationInstance.CompleteRequest() for Current.Response.End() and the file gets downloaded correclty
and now i cant call my download code directly:
Server.ClearError()
WFT.DownloadServerFile("ExcelTemplates\" & vFilename, MIMEType.Excel2007, nfilename)
iProcess = "btnExcel_Click 28"
Catch ex As Exception
EnableErrorByState(ex.Message & ", Process: " & iProcess)
If File.Exists(Server.MapPath(".") & "\ExcelTemplates\" & vFilename) = True Then
File.Delete(Server.MapPath(".") & "\ExcelTemplates\" & vFilename)
End If
End Try
Finally
loOraClientDb.Close()
ShowCorrespondingWindows()
End Try
It's not suposed to be the correct way of using Response.End, because it always trows an error but I don't now if this is the correct way of using Current.ApplicationInstance.CompleteRequest() or that Response.End does something that CompleteRequest is not doing in order for it to get the correct MIME Type