VBA另存为CSV正在乱码我的数据类型



处理Excel 2013有点令人生气的时间,我似乎找不到任何可以满足我需求的答案。

我编写了一些简单的 VBA,它生成了许多虚拟数据表,输出生成绝对正常,并且在导出之前输出表中的格式似乎是正确的。

但是,我遇到困难的元素是当我使用 VBA 将文件导出为 CSV 时(它们需要上传到 SQL Server)。导出本身工作正常,但是当我尝试在Excel中重新打开文件时,日期列中的数据类型是"乱码"。我在英国,计算机是这样设置的,但 Excel 似乎正在将这些转换为美国格式,这意味着有些是"日期"(任何适合英国格式的字符串),有些是"通用",这显然会导致上传到 SQL Server 时出现问题。

我尝试手动复制数据选项卡,并将它们另存为 CSV。当我这样做时,我可以打开它们,日期格式绝对没问题。因此,我只能假设这与我的出口有关,任何想法将不胜感激。

代码如下:

Sub exportdata()
wdir = ThisWorkbook.Path
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Save sheets which aren't the command sheet.
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "Command" Then
Application.StatusBar = "Exporting sheet " & sht.Name
sht.Copy
Application.ActiveWorkbook.SaveAs wdir & "Generated" & sht.Name & ".csv", xlCSVWindows
Application.ActiveWorkbook.Close False
End If
Next
Application.StatusBar = ""

有人有什么想法吗?感谢我可以手动导出每个选项卡,但这非常烦人,我需要运行很多次。

注意 - 我尝试使用xlCsv和xlCsvWindows,同样的事情发生了。

我遇到了同样的问题。

我知道避免这种情况的唯一方法是打开 Excel 并从 Excel 打开文件。 打开文件时,会弹出一个屏幕,Excel 希望从用户那里知道需要如何打开数据。

我通常做的是在 3 屏幕中选择所有列并将它们定义为文本。这还可以防止您丢失前导零(如果适用)。这种方式在Excel中数字是文本(你不能用它们计算,但SAP不介意将数字作为文本上传:)。

在另存为 CSV 之前循环浏览您的日期范围怎么样,如下所示:

Sub exportdata()
Dim c As Range
Dim sht As Worksheet
Dim LastRow As Long
wdir = ThisWorkbook.Path
Application.DisplayAlerts = False
Application.ScreenUpdating = False
'Save sheets which aren't the command sheet.
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "Command" Then
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
For Each c In sht.Range("A1:A" & LastRow) 'loop through column A to format dates
c.Value = Format(c, "dd/mm/yyyy")
Next c
Application.StatusBar = "Exporting sheet " & sht.Name
'sht.Copy
Application.ActiveWorkbook.SaveAs wdir & "Generated" & sht.Name & ".csv", xlCSVWindows
Application.ActiveWorkbook.Close False
End If
Next
Application.StatusBar = ""
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

我不知道这是否有效(并且无法测试它,因为我住在美国),但一个想法是复制/粘贴每个工作表中的值,而不是直接复制工作表。

Sub exportData()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
If Not ws.Name = "Command" Then
Application.StatusBar = "Exporting sheet " & ws.Name
Call createTextFile(ws.UsedRange, ws.Parent.Path & "Generated", ws.Name & ".csv", xlCSV)
End If
Next
Application.StatusBar = ""
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Sub createTextFile(sourceRng As Range, fPath As String, fName As String, fFormat As Variant)
Dim wb As Workbook
Set wb = Workbooks.Add
sourceRng.Copy
With wb.Sheets(1)
.Range(.Cells(1, 1), .Cells(sourceRng.Rows.Count, sourceRng.Columns.Count)).PasteSpecial _
Paste:=xlPasteValuesAndNumberFormats
End With
Application.CutCopyMode = False
wb.SaveAs Filename:=fPath & fName, FileFormat:=fFormat
wb.Close
End Sub

如果这不起作用,我很想知道问题是否只与扩展名为.csv的文件有关;您可以通过更改此行来测试.txt文件:

Call createTextFile(ws.UsedRange, ws.Parent.Path & "Generated", ws.Name & ".csv", xlCSV)

对此:

Call createTextFile(ws.UsedRange, ws.Parent.Path & "Generated", ws.Name & ".txt", xlText)

作为最后的手段,您可以将日/月/年分成单独的列,然后修改 SQL 脚本以在更新表时合并它们。像这样:

CREATE TABLE #temptbl
(
dtyear int,
dtmonth int,
dtday int,
dtdate AS (DATEFROMPARTS(dtyear, dtmonth, dtday)),
empid varchar(8),
hrsworked int
);
BULK INSERT #temptbl
FROM '\yourpathuploadfile.txt'
WITH
(
FIELDTERMINATOR = 't',
ROWTERMINATOR = 'n'
);
MERGE dbo.emphours AS target
USING #temptbl AS source
ON
(target.empid = source.empid) AND
(target.dtdate = source.dtdate)
WHEN MATCHED AND (target.hrsworked <> source.hrsworked) THEN
UPDATE SET
target.hrsworked = source.hrsworked
WHEN NOT MATCHED BY target THEN
INSERT
(dtdate,empid,hrsworked)
VALUES
(source.dtdate,source.empid,source.hrsworked);
DROP TABLE #tempHH;

最新更新